home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / allswag.zip / SORTING.SWG < prev    next >
Text File  |  1993-12-08  |  169KB  |  1 lines

  1. SWAGOLX.EXE (c) 1993 GDSOFT  ALL RIGHTS RESERVED 00042         SORTING ROUTINES                                                  1      05-28-9313:57ALL                      SWAG SUPPORT TEAM        ALPHAREC.PAS             IMPORT              7      S¼═ { Alphabetic Rec Sort }ππProcedure SortIt(Key : Byte);πVarπ  I, J : Byte;ππProcedure Swapper;πVarπ  T : Member;ππbeginπ  T := Memrec[I];π  MemRec[I] := MemRec[J];π  MemRec[J] := T;πend;ππbeginπ  For I := 1 to MaxMem - 1 DOπ   For J := I To MaxMem do beginπ     Case Key OFπ       1 : if MemRec[I].Firstname < MemRec[J].FirstName then Swapper;π       2 : if MemRec[I].LastName  < MemRec[J].LastName  then Swapper;π       3 : if MemRec[I].Points    < MemRec[J].Points    then Swapper;π     end;πend;ππ{πAnother Alternative would be to do as C does, make a Generic Sort routineπwhere you pass it a Function that returns > 0 if Record1 is greater thanπRecord2, < 0 if Record1 is Less than Record2, and 0 if they are the same.π}π                                            2      05-28-9313:57ALL                      GUY MCLOUGHLIN           Anangram Sort            IMPORT              196    S└j  (* Start of PART 1 of 7 *)ππ(***********************************************************************π          Contest 3 Entry : Anagram Sort by Guy McLoughlinπ          Compiler        : Borland Pascal 7.0π***********************************************************************)ππ {.$DEFINE DebugMode}ππ {$IFDEF DebugMode}π   {$A+,B-,D+,E-,F-,G+,I+,L+,N-,O-,P-,Q+,R+,S+,T+,V+,X-}π {$ELSE}π   {$A+,B-,D-,E-,F-,G+,I-,L-,N-,O-,P-,Q-,R-,S+,T-,V-,X-}π {$endIF}ππ {$M 16384,374784,655360}ππProgram Anagram_Sort;ππConstπ  co_MaxWord  =  2500;π  co_MaxSize  = 65519;π  co_SafeSize = 64500;ππTypeπ  Char_12 = Array[1..12] of Char;ππ  st_4    = String[4];π  st_10   = String[10];π  st_80   = String[80];ππ  byar_26 = Array[97..122] of Byte;ππ  po_Buff     = ^byar_Buffer;π  byar_Buffer = Array[1..co_MaxSize] of Byte;ππ  porc_Word = ^rc_Word;π  rc_Word   = Recordπ                wo_Pos    : Word;π                ar_LtrChk : Char_12;π                st_Word   : st_10π              end;ππ  poar_Word     = Array[0..co_MaxWord] of porc_Word;ππ  porc_AnaGroup = ^rc_AnaGroup;π  rc_AnaGroup   = Recordπ                    wo_Pos   : Word;π                    st_Group : st_80π                  end;ππ  poar_AnaGroup = Array[0..co_MaxWord] of porc_AnaGroup;π  poar_Generic  = Array[0..co_MaxWord] of Pointer;ππ  (***** Check For I/O errors.                                        *)π  (*                                                                  *)π  Procedure CheckIOerror;π  Varπ    by_Error : Byte;π  beginπ    by_Error := ioresult;π    if (by_Error <> 0) thenπ      beginπ        Writeln('Input/Output error = ', by_Error);π        haltπ      endπ  end;        (* CheckIOerror.                                        *)ππ  (***** Display HEAP error message.                                  *)π  (*                                                                  *)π  Procedure HeapError;π  beginπ    Writeln('Insuficient free HEAP memory');π    haltπ  end;        (* HeapError.                                        *)ππTypeπ  Item     = Pointer;π  ar_Item  = poar_Generic;π  CompFunc = Function(Var Item1, Item2 : Item) : Boolean;ππ (* end of PART 1 of 7 *)π (* Start of PART 2 of 7 *)ππ  (***** QuickSort routine.                                           *)π  (*                                                                  *)π  Procedure QuickSort({update} Var ar_Data  : ar_Item;π                      {input }     wo_Left,π                                   wo_Right : Word;π                                   LessThan : CompFunc);π  Varπ    Pivot,π    TempItem : Item;π    wo_Index1,π    wo_Index2 : Word;π  beginπ    wo_Index1 := wo_Left;π    wo_Index2 := wo_Right;π    Pivot := ar_Data[(wo_Left + wo_Right) div 2];π    Repeatπ      While LessThan(ar_Data[wo_Index1], Pivot) doπ        inc(wo_Index1);π      While LessThan(Pivot, ar_Data[wo_Index2]) doπ        dec(wo_Index2);π      if (wo_Index1 <= wo_Index2) thenπ        beginπ          TempItem := ar_Data[wo_Index1];π          ar_Data[wo_Index1] := ar_Data[wo_Index2];π          ar_Data[wo_Index2] := TempItem;π          inc(wo_Index1);π          dec(wo_Index2)π        endπ      Until (wo_Index1 > wo_Index2);π      if (wo_Left < wo_Index2) thenπ        QuickSort(ar_Data, wo_Left, wo_Index2, LessThan);π      if (wo_Index1 < wo_Right) thenπ        QuickSort(ar_Data, wo_Index1, wo_Right, LessThan)π  end;        (* QuickSort.                                           *)ππ  (***** Sort Function to check if anagram-Word's are in sorted order *)π  (*                                                                  *)π  Function AlphaSort(Var Item1, Item2 : Item) : Boolean; Far;π  beginπ    AlphaSort := (porc_Word(Item1)^.st_Word < porc_Word(Item2)^.st_Word)π  end;        (* AlphaSort.                                           *)ππ  (***** Sort Function to check:                                      *)π  (*                                                                  *)π  (*        1 - If anagram-Words are sorted by length.                *)π  (*        2 - If anagram-Words are sorted by anagram-group.         *)π  (*        3-  If anagram-Words are sorted alphabeticly.             *)π  (*                                                                  *)π  Function Sort1(Var Item1, Item2 : Item) : Boolean; Far;π  beginπ    if (porc_Word(Item1)^.st_Word[0] <>π                                      porc_Word(Item2)^.st_Word[0]) thenπ      Sort1 := (porc_Word(Item1)^.st_Word[0] <π                                           porc_Word(Item2)^.st_Word[0])π    elseπ      if (porc_Word(Item1)^.ar_LtrChk <>π                                       porc_Word(Item2)^.ar_LtrChk) thenπ        Sort1 := (porc_Word(Item1)^.ar_LtrChk <π                                            porc_Word(Item2)^.ar_LtrChk)π      elseπ        Sort1 := (porc_Word(Item1)^.wo_Pos < porc_Word(Item2)^.wo_Pos)π  end;        (* Sort1.                                               *)ππ  (***** Sort Function to check:                                      *)π  (*                                                                  *)π  (*     If anagram-group Strings are sorted alphabeticly.            *)π  (*                                                                  *)π  Function Sort2(Var Item1, Item2 : Item) : Boolean; Far;π  beginπ    Sort2 := (porc_AnaGroup(Item1)^.wo_Pos <π                                           porc_AnaGroup(Item2)^.wo_Pos)π  end;        (* Sort2.                                               *)ππ (* end of PART 2 of 7 *)π (* Start of PART 3 of 7 *)ππ  (***** Check if the anagram-Word table is in sorted order.          *)π  (*                                                                  *)π  Function TableSorted({input } Var ar_Data  : poar_Word;π                                    wo_Left,π                                    wo_Right : Word) : {output} Boolean;π  Varπ    wo_Index : Word;π  beginπ              (* Set Function result to True.                         *)π    TableSorted := True;ππ              (* Loop through all but the last Word in the anagram-   *)π              (* Word "table".                                        *)π    For wo_Index := wo_Left to pred(wo_Right) doπ              (* Check if the current and next anagram-Words are not  *)π              (* sorted.                                              *)π      if (ar_Data[wo_Index]^.st_Word >π                                ar_Data[succ(wo_Index)]^.st_Word) thenπ      beginπ              (* Set Function result to False, and break the "for"    *)π              (* loop.                                                *)π        TableSorted := False;π        breakπ      endπ  end;        (* TableSorted.                                         *)ππ  (***** Pack bits 0,1,2 of each Byte in 26 Byte Array into 10 Chars. *)π  (*                                                                  *)π  Procedure PackBits({input } Var byar_Temp : byar_26;π                     {output} Var Char_Temp : Char_12);π  beginπ    Char_Temp[ 1] := chr((byar_Temp[ 97] and $7) shl 5 +π                         (byar_Temp[ 98] and $7) shl 2 +π                         (byar_Temp[ 99] and $6) shr 1);π    Char_Temp[ 2] := chr((byar_Temp[ 99] and $1) shl 7 +π                         (byar_Temp[100] and $7) shl 4 +π                         (byar_Temp[101] and $7) shl 1 +π                         (byar_Temp[102] and $4) shr 2);π    Char_Temp[ 3] := chr((byar_Temp[102] and $3) shl 6 +π                         (byar_Temp[103] and $7) shl 3 +π                         (byar_Temp[104] and $7));π    Char_Temp[ 4] := chr((byar_Temp[105] and $7) shl 5 +π                         (byar_Temp[106] and $7) shl 2 +π                         (byar_Temp[107] and $6) shr 1);π    Char_Temp[ 5] := chr((byar_Temp[107] and $1) shl 7 +π                         (byar_Temp[108] and $7) shl 4 +π                         (byar_Temp[109] and $7) shl 1 +π                         (byar_Temp[110] and $4) shr 2);π    Char_Temp[ 6] := chr((byar_Temp[110] and $3) shl 6 +π                         (byar_Temp[111] and $7) shl 3 +π                         (byar_Temp[112] and $7));π    Char_Temp[ 7] := chr((byar_Temp[113] and $7) shl 5 +π                         (byar_Temp[114] and $7) shl 2 +π                         (byar_Temp[115] and $6) shr 1);π    Char_Temp[ 8] := chr((byar_Temp[115] and $1) shl 7 +π                         (byar_Temp[116] and $7) shl 4 +π                         (byar_Temp[117] and $7) shl 1 +π                         (byar_Temp[118] and $4) shr 2);π    Char_Temp[ 9] := chr((byar_Temp[118] and $3) shl 6 +π                         (byar_Temp[119] and $7) shl 3 +π                         (byar_Temp[120] and $7));π    Char_Temp[10] := chr((byar_Temp[121] and $7) shl 5 +π                         (byar_Temp[122] and $7) shl 2)π  end;        (* PackBits.                                            *)ππVarπ  po_Buffer       : po_Buff;ππ  by_Index,π  by_LastAnagram,π  by_CurrentWord  : Byte;ππ  wo_Index,π  wo_ReadIndex,π  wo_TableIndex,π  wo_BufferIndex,π  wo_CurrentIndex : Word;ππ (* end of PART 3 of 7 *)π (* Start of PART 4 of 7 *)ππ  st_Temp         : st_4;ππ  byar_LtrChk     : byar_26;ππ  fi_Temp         : File;ππ  rcar_Table      : poar_Word;ππ  rcar_Groups     : poar_AnaGroup;πππ              (* Main Program execution block.                        *)πbeginπ              (* If there is sufficient room, allocate the main data- *)π              (* buffer on the HEAP.                                  *)π  if (maxavail > co_MaxSize) thenπ    new(po_Buffer)π  elseπ              (* Else, inform user of insufficient HEAP memory, and   *)π              (* halt the Program.                                    *)π    HeapError;ππ              (* Clear the data-buffer.                               *)π  fillChar(po_Buffer^, co_MaxSize, 0);ππ              (* Initialize counter Variable.                         *)π  wo_Index := 0;ππ              (* While the counter is less than co_MaxWord do...      *)π  While (co_MaxWord > wo_Index) doππ              (* If there is sufficient memory, allocate another      *)π              (* anagram-Word Record on the HEAP.                     *)π    if (maxavail > sizeof(rc_Word)) thenπ      beginπ        inc(wo_Index);π        new(rcar_Table[wo_Index]);π        fillChar(rcar_Table[wo_Index]^, sizeof(rc_Word), 0);π      endπ    elseπ              (* Else, inform user of insufficient HEAP memory, and   *)π              (* halt the Program.                                    *)π      HeapError;ππ              (* Initialize counter Variable.                         *)π  wo_Index := 0;ππ              (* While the counter is less than co_MaxWord do...      *)π  While (co_MaxWord > wo_Index) doππ              (* If there is sufficient memory, allocate another      *)π              (* anagram-group String on the HEAP.                    *)π    if (maxavail > sizeof(rc_AnaGroup)) thenπ      beginπ        inc(wo_Index);π        new(rcar_Groups[wo_Index]);π        fillChar(rcar_Groups[wo_Index]^, sizeof(rc_AnaGroup), 32);π      endπ    elseπ              (* Else, inform user of insufficient HEAP memory, and   *)π              (* halt the Program.                                    *)π      HeapError;ππ              (* Attempt to open File containing the anagram-Words.   *)π  assign(fi_Temp, 'WordLIST.DAT');ππ              (* Set Filemode to "read-only".                         *)π  Filemode := 0;π  {$I-}π  reset(fi_Temp, 1);π  {$I+}π              (* Check For I/O errors.                                *)π  if (ioresult <> 0) thenπ    beginπ      Writeln('Error opening anagram data File ---> WordLIST.DAT');π      haltπ    end;π              (* Read-in the entire anagram list into the data-buffer *)π  blockread(fi_Temp, po_Buffer^, co_MaxSize, wo_ReadIndex);ππ (* end of PART 4 of 7 *)π (* Start of PART 5 of 7 *)ππ              (* Check For I/O errors.                                *)π  CheckIOerror;ππ  close(fi_Temp);ππ              (* Check For I/O errors.                                *)π  CheckIOerror;ππ              (* Initialize index Variables.                          *)π  wo_TableIndex  := 0;π  wo_BufferIndex := 0;ππ              (* Repeat...Until all data in the data-buffer has been  *)π              (* processed.                                           *)π  Repeatππ              (* Repeat...Until a valid anagram-Word Character has    *)π              (* been found, or the complete data-buffer has been     *)π              (* processed.                                           *)π    Repeatπ      inc(wo_BufferIndex)π    Until ((po_Buffer^[wo_BufferIndex] > 96)π      and (po_Buffer^[wo_BufferIndex] < 123))π       or (wo_BufferIndex > wo_ReadIndex);ππ              (* If the complete data-buffer has been processed then  *)π              (* break the Repeat...Until loop.                       *)π    if (wo_BufferIndex > wo_ReadIndex) thenπ      break;ππ              (* Advance the anagram-Word "table" index.              *)π    inc(wo_TableIndex);ππ              (* Clear the "letter check" Byte-Array Variable.        *)π    fillChar(byar_LtrChk, sizeof(byar_26), 0);ππ              (* Repeat...Until not an anagram-Word Character,  or    *)π              (* complete data-buffer has been processed.             *)π    Repeatππ              (* With the current anagram-Word Record do...           *)π      With rcar_Table[wo_TableIndex]^ doπ        beginπ              (* Record the number of each alphabetical Character in  *)π              (* the anagram-Word.                                    *)π          inc(byar_LtrChk[po_Buffer^[wo_BufferIndex]]);ππ              (* Advance the String length-Character.                 *)π          inc(st_Word[0]);ππ              (* Add the current anagram-Word Character to anagram-   *)π              (* Word String.                                         *)π          st_Word[ord(st_Word[0])] :=π                                    chr(po_Buffer^[wo_BufferIndex]);ππ              (* Advance the data-buffer index.                       *)π          inc(wo_BufferIndex)ππ        endπ    Until (po_Buffer^[wo_BufferIndex] < 97)π       or (po_Buffer^[wo_BufferIndex] > 122)π       or (wo_BufferIndex > wo_ReadIndex);ππ              (* Pack bits 0,1,2 of each Character in "letter-check"  *)π              (* Variable, to store Variable as 10 Char data. This    *)π              (* reduces memory storage requirements by 16 Bytes For  *)π              (* each anagram-Word, and makes data faster to sort.    *)π    PackBits(byar_LtrChk, rcar_Table[wo_TableIndex]^.ar_LtrChk);ππ  Until (wo_BufferIndex > wo_ReadIndex);ππ              (* Check if the Array of anagram-Words in the "table"   *)π              (* Array are sorted. If not then sort them.             *)π  if not TableSorted(rcar_Table, 1, wo_TableIndex) thenπ    QuickSort(poar_Generic(rcar_Table), 1, wo_TableIndex, AlphaSort);ππ              (* Record the position of all the anagram-Words on the  *)π              (* "table" Array. This will be used as a faster sorting *)π              (* index.                                               *)π  For wo_Index := 1 to wo_TableIndex doπ    rcar_Table[wo_Index]^.wo_Pos := wo_Index;ππ (* end of PART 5 of 7 *)π  (* Start of PART 6 of 7 *)ππ              (* QuickSort the "table" of anagram Words, using Sort1  *)π              (* routine.                                             *)π  QuickSort(poar_Generic(rcar_Table), 1, wo_TableIndex, Sort1);ππ              (* Attempt to open a File to Write sorted data to.      *)π  assign(fi_Temp, 'SORTED.DAT');π  {$I-}π  reWrite(fi_Temp, 1);ππ              (* Check For I/O errors.                                *)π  CheckIOerror;ππ              (* Set the temporary String to ', ' + Cr + Lf.          *)π  st_Temp := ', ' + #13#10;ππ              (* Reset the loop index.                                *)π  wo_Index      := 1;ππ              (* Repeat...Until all anagram-Word on "table" Array are *)π              (* processed.                                           *)π  Repeatππ              (* Reset the counter Variables.                         *)π    by_LastAnagram := 0;π    by_CurrentWord := 0;ππ              (* While the next anagram-Word belongs to the same      *)π              (* anagram-group, advance the by_LastAnagram Variable.  *)π    While (rcar_Table[(wo_Index + by_LastAnagram)]^.ar_LtrChk =π              rcar_Table[succ(wo_Index + by_LastAnagram)]^.ar_LtrChk) doπ      inc(by_LastAnagram);ππ              (* Repeat...Until next anagram-Word is not in the same  *)π              (* anagram group.                                       *)π    Repeatππ              (* With current anagram group do...                     *)π      With rcar_Groups[(wo_Index + by_CurrentWord)]^ doπ        beginππ              (* Move the first anagram-Word in "table" Array to the  *)π              (* current anagram group-String.                        *)π          move(rcar_Table[(wo_Index + by_CurrentWord)]^.st_Word[1],π               st_Group[1], ord(rcar_Table[(wo_Index +π                                         by_CurrentWord)]^.st_Word[0]));ππ              (* Set the length-Char of current anagram-String to 12. *)π          st_Group[0] := #12;ππ              (* Record the first anagram-Word position.              *)π          wo_Pos := rcar_Table[(wo_Index + by_CurrentWord)]^.wo_Pos;ππ              (* Loop from 0 to total number of anagrams in the group *)π          For by_Index := 0 to by_LastAnagram doππ              (* If the loop index is not equal the the current       *)π              (* anagram-Word, then...                                *)π            if (by_Index <> by_CurrentWord) thenπ              beginππ              (* Add the next anagram-Word to the anagram-String.     *)π                move(rcar_Table[(wo_Index + by_Index)]^.st_Word[1],π                     st_Group[succ(length(st_Group))],π                     ord(rcar_Table[(wo_Index +π                                               by_Index)]^.st_Word[0]));ππ              (* Record the length of the anagram-Word added to the   *)π              (* anagram-String.                                      *)π                inc(st_Group[0],π                    ord(rcar_Table[(wo_Index +π                                               by_Index)]^.st_Word[0]));ππ              (* If the current anagram-Word is not the last anagram- *)π              (* Word of the anagram-group, and the loop-index is     *)π              (* less than the last anagram-Word, or the loop-index   *)π              (* is less than the 2nd to last anagram-Word in group   *)π                if ((by_CurrentWord <> by_LastAnagram) andπ                    (by_Index < by_LastAnagram))π                or (by_Index < pred(by_LastAnagram)) thenπ                  beginππ (* end of PART 6 of 7 *)π (* Start of PART 7 of 7 *)ππ              (* Add the comma and space Character to anagram-String. *)π                    move(st_Temp[1],π                                   st_Group[succ(length(st_Group))], 2);π                    inc(st_Group[0], 2)π                  endπ              end;ππ              (* Add the CR + Lf to anagram String.                   *)π          move(st_Temp[3], st_Group[succ(length(st_Group))], 2);π          inc(st_Group[0], 2);ππ              (* Advance the currrent anagram-Word index.             *)π          inc(by_CurrentWord)ππ        endπ    Until (by_CurrentWord > by_LastAnagram);ππ              (* Advance the anagram-group index by the current       *)π              (* anagram-Word index.                                  *)π    inc(wo_Index, by_CurrentWord);ππ  Until (wo_Index > wo_TableIndex);ππ              (* QuickSort the anagram-Strings, using Sort2.          *)π  QuickSort(poar_Generic(rcar_Groups), 1, wo_TableIndex, Sort2);ππ              (* Initialize loop control Variable.                    *)π  wo_CurrentIndex := 1;ππ              (* Repeat Until all the anagram Words in the "table"    *)π              (* Array have been processed.                           *)π  Repeatππ              (* Initialize loop control Variable.                    *)π    wo_BufferIndex := 1;ππ              (* Place all the anagram-Strings in the data-buffer.    *)π    While (wo_CurrentIndex <= wo_TableIndex)π    and   (wo_BufferIndex  < co_SafeSize) doπ      With rcar_Groups[wo_CurrentIndex]^ doπ        beginπ              (* Place current anagram-String in the data-buffer.     *)π          move(st_Group[1], po_Buffer^[wo_BufferIndex],π                                                      length(st_Group));ππ              (* Advance the data-buffer index by length of anagram-  *)π              (* String.                                              *)π          inc(wo_BufferIndex, length(st_Group));ππ              (* Advance current anagram-String index.                *)π          inc(wo_CurrentIndex)ππ        end;ππ              (* Write the anagram Text data in the buffer to disk.   *)π    blockWrite(fi_Temp, po_Buffer^[1], pred(wo_BufferIndex));ππ              (* Check For I/O errors.                                *)π    CheckIOerror;ππ  Until (wo_CurrentIndex >= wo_TableIndex);ππ              (* Close the sorted anagram-Text File.                  *)π  close(fi_Temp);ππ              (* Check For I/O errors.                                *)π  CheckIOerrorππend.ππ (* end of PART 7 of 7 *)π{  Hi, to All:ππ  ...I gather that the 3rd Programming contest (Anagram Word sort)π  is officially over, and am now posting my entry's source-code.ππ  This Program should execute in well under 1 second on a 486-33π  ram-disk. (It's about 3.21 sec on my 386sx-25) The final compiledπ  size of the .EXE is 7360 Bytes.ππ  ...I've commented the h*ll out of my source-code, so it's a bitπ  on the big side.ππ  ...Here is a "quick" run-down of how it works:ππ      1- Creates a 60K buffer on the HEAP.ππ      2- Creates an Array table to store all the anagram Wordsπ         and data about each Word, on the HEAP.ππ      3- Creates an Array of anagram-group Strings on the HEAP.ππ      4- Read the entire anagram-Word input File WordLIST.DATπ         into the 60K buffer in 1 big chunk.ππ      5- Finds all the anagram-Words in the buffer, and assignsπ         their data to the anagram-Word table on the HEAP.ππ      6- Each letter of every anagram-Word is Recorded in anπ         Array of 26 Bytes. Then the first 3 bits of each ofπ         the 26 Bytes is packed, so that this data can beπ         stored in a 10 Character Array in each anagram-Wordπ         table Record. (The bits are packed to save space andπ         to make the sorting faster.) This method allows forπ         a maximum of 7 of the same letter in each Word, whichπ         should be sufficient For this contest.ππ      7- The table of anagram Records is then checked to see ifπ         the anagram-Words are in sorted order. (In this contestπ         the original input File is in sorted order.) If they areπ         not in sorted order, QuickSort is called to put theπ         Words (actually Pointers to the Words) in order.ππ      8- Now that the anagram-Words are in sorted order, theirπ         position in the anagram-Word table is Recorded in aπ         position field within each anagram-Word Record.ππ      9- The table of anagram-Word Records is now sorted usingπ         a multi-key QuickSort. This will sort the anagram-Wordπ         Records by:π                     1- Length of anagram-Word.π                     2- Letters that each anagram-Word contains.π                     3- Alphabeticly.ππ         ...This multi-key sort will establish the anagram groups,π         and sort the members of each group alphabeticly.ππ     10- Open the sorted output File.ππ     11- Create N number of anagram-Strings from N mumber of anagram-π         Words in each anagram-group. Keeping the anagram Words inπ         the String in sorted order.ππ     12- QuickSort the anagram-group Strings into alphabetical order.ππ     13- Place all the sorted anagram-group Strings back into theπ         60K buffer.ππ     14- Write the entire buffer to the SORTED.DAT File, and closeπ         this File.ππ   NOTES: Well this is the first time I've figured out how to doπ          multi-key QuickSorts, which I wasn't sure was possibleπ          at first.ππ          I also tried using a 32-bit CRC value to identify theπ          anagram-groups which ran even faster, but should notπ          be considered a "safe" method, as it's accuracy is onlyπ          guaranteed For 2-7 Character Words.ππ          File I/O and repetitive loops are usually the big speedπ          killers in these Types of contests, so I always try toπ          keep them to a minimum.ππ          ...My entry could possibly be tweaked further still,π          but I've got a life. <g>ππ}                                                                                                      3      05-28-9313:57ALL                      SWAG SUPPORT TEAM        ANAGRAM2.PAS             IMPORT              125    Shó { ANAGRAM. --------------------------------------------------------------------π  Raphaël Vanney, 01/93ππ  Purpose : Reads a list of Words 4 to 10 Characters long from a Fileπ            named 'LIST.#1', outputs a list of anagrams founds in aπ            specified format to a File named 'ANAGRAM.RES'.ππ  Note    : I commented-out the source using a langage, say English, whichπ            I'm not Really fluent in ; please forgive mistakes.π------------------------------------------------------------------------------}ππ{$m 8192,65536,655360}π{$a+,d+,e-,f-,g+,i+,l+,n-,o-,q-,r-,s-,v+}ππ{$b-}     { Turns off complete Boolean evaluation ; this allows easiestπ            combined Boolean tests. }ππUses Crt,π     Objects ;ππConstπ     MaxWordLen     = 10 ;              { Offically specified by GP !      }π     CntAnagrams    : Word = 0 ;        { Actually, this counter shows the }π                                        { number of Words found in the     }π                                        { output File.                     }π     OutFileName    = 'ANAGRAM.RES' ;πππType TWordString    = String[MaxWordLen] ;ππ     { TWordCollection.π       This Object will be used to store the Words in a sorted fashion. Asπ       long as the input list is already sorted, it could have inheritedπ       from TCollection, put there is no big penalty using a sorted one.   }ππ     TWordCollection =π     Object (TSortedCollection)π          Function  KeyOf(Item : Pointer) : Pointer ; Virtual ;π          Function  Compare(Key1, Key2 : Pointer) : Integer ; Virtual ;π          Procedure FreeItem(Item : Pointer) ; Virtual ;π     end ;π     PWordCollection = ^TWordCollection ;ππ     { TWord.π       This is the Object we'll use to store a Word. Each Word knows :π       - it's 'Textual form'  : Itπ       - the first of it's anagrams, if it has been found to be theπ         anagram of another Word,π       - the next of it's anagrams, in the same condition.                 }ππ     PWord     = ^TWord ;π     TWord     =π     Objectπ          It             : TWordString ;π          FirstAng       : PWord ;π          NextAng        : PWord ;ππ          Constructor    Init(Var Wrd  : TWordString) ;π          Destructor     Done ;π     end ;ππVar  WordsList : PWordCollection ;      { The main list of Words           }π     OrgMem    : LongInt ;              { Original MemAvail                }π     UsedMem   : LongInt ;              { Amount of RAM used               }ππ{-------------------------------------- TWord --------------------------------}ππConstructor TWord.Init ;πbeginπ     It:=Wrd ;π     FirstAng:=Nil ;π     NextAng:=Nil ;πend ;ππDestructor TWord.Done ;πbeginπend ;ππ{-------------------------------------- TWordCollection ----------------------}π{ The following methods are not commented out, since they already are inπ  Turbo-Pascal's documentations, and they do nothing unusual.              }ππFunction TWordCollection.KeyOf ;πbeginπ     KeyOf:=Addr(PWord(Item)^.It) ;πend ;ππFunction TWordCollection.Compare ;πVar  k1   : PString Absolute Key1 ;π     k2   : PString Absolute Key2 ;πbeginπ     If k1^>k2^π     Then Compare:=1π     Else If k1^<k2^π          Then Compare:=-1π          Else Compare:=0 ;πend ;ππProcedure TWordCollection.FreeItem ;πbeginπ     Dispose(PWord(Item), Done) ;πend ;ππ{-------------------------------------- Utilities ----------------------------}ππProcedure CleanUp(Var Wrd : TWordString) ;π{ Cleans-up a Word, in Case there would be dirty Characters in the input File }πVar  i    : Integer ;πbeginπ     { Removes trailing spaces ; not afraid of empty Strings }π     While Wrd[Length(Wrd)]=' ' Do Dec(Wrd[0]) ;π     { Removes any suspect Character }π     i:=1 ;π     While (i<=Length(Wrd)) Doπ     beginπ          If Wrd[i]<#33 Then Delete(Wrd, i, 1)π                        Else Inc(i) ;π     end ;πend ;ππFunction PadStr(St : TWordString ; Len : Integer) : String ;π{ Returns a String padded With spaces, of the specified length }πVar  i    : Integer ;π     Tmp  : String ;πbeginπ     Tmp:=St ;π     For i:=Length(Tmp)+1 To Len Do Tmp[i]:=' ' ;π     Tmp[0]:=Chr(Len) ;π     PadStr:=Tmp ;πend ;ππ{-----------------------------------------------------------------------------}ππFunction AreAnagrams(Var WordA, WordB : TWordString) : Boolean ;π{ Tells whether two Words are anagrams of each other ; assumes the Wordsπ  are 'clean' (No Up/Low Case checking, no dirty Characters...)ππ  Optimizing hint : Passing parameters by address _greatly_ enhances overallπ  speed ; anyway, we'll use a local copy of one of the two, since the usedπ  algorithms needs to modify one of the two Words.                         }ππAssembler ;πVar  WordC     : TWordString ;          { Local copy of WordB              }πAsmπ     Push DS                            { Let's save the Data segment...   }π     LDS  SI, WordA                     { Load WordA's address in ES:DI    }π     Mov  AL, [SI]                      { Load length Byte into AL         }π     LDS  SI, WordB                     { Load WordB's address             }π     Cmp  AL, [SI]                      { Compare lengthes                 }π     JNE  @NotAng                       { <>lengthes, not anagrams         }ππ     LDS  SI, WordBππ     { Let's make a local copy of WordB ; enhanced version of TP's "Move"  }π     ClD                                { Clear direction flag             }π     Push SSπ     Pop  ES                            { Segment part of WordC's address  }π     LEA  DI, WordC                     { Offset part of it                }π     Mov  CL, DS:[SI]                   { Get length Byte                  }π     XOr  CH, CH                        { Make it a Word                   }π     Mov  DL, CL                        { Save length For later use        }π     Inc  CX                            { # of Bytes to store the String   }π     ShR  CX, 1                         { We'll copy Words ; CF is importt }π     Rep  MovSW                         { Copy WordB to WordC              }π     JNC  @NoByteπ     MovSB                              { Copy last Byte                   }π@NoByte:π     LDS  SI, WordA                     { DS:SI contains WordA's address   }π     Inc  SI                            { SI points to first Char of WordA }π     Mov  DH, DL                        { Use DH as a loop counter         }π     LEA  BX, WordC                     { Load offset of WordC in BX       }π     Inc  BX                            { Skip length Byte                 }π     { For each letter in WordA, search it in WordB ; if found, mark it asπ       'used' in WordB, then proceed With next.π       If a letter is not found, Words are not anagrams ; if all areπ       found, Words are anagrams.                                          }π{ Registers usage :π     AL        : scratch For SCASπ     AH        : unusedπ     BX        : offset part of WordC's addressπ     CX        : will be used as a counter For SCASπ     DL        : contains length of Strings ; 'll be used to reset CXπ     DH        : loop counter ; initially =DLπ     ES        : segment part of WordC's addressπ     DI        : scratch For SCASπ     DS:SI     : Pointer to next Char to process in WordAπ}π@Bcle:π     LodSB                              { Load next Char of WordA in AL    }π     Mov  CL, DL                        { Load length of String in CX      }π     Mov  DI, BX                        { Copy offset of WordC to DI       }π     RepNE ScaSB                        { Scan WordC For AL 'till found    }π     JNE  @NotAng                       { Char not found, not anagrams     }π     Dec  DI                            { Back-up to matching Char         }π     Mov  Byte Ptr ES:[DI], '*'         { Mark the Character as 'used'     }π     Dec  DH                            { Dec loop counter                 }π     Or   DH, DH                        { Done all Chars ?                 }π     JNZ  @Bcle                         { No, loop                         }ππ     { All Chars done, the Words are anagrams                              }π     Mov  AL, 1                         { Result=True                      }π     Or   AL, AL                        { Set accordingly the ZF           }π     Jmp  @Doneπ@NotAng:π     XOr  AL, AL                        { Result=False                     }π@Done:π     Pop  DS                            { Restore DS                       }πend ;ππFunction ReadWordsFrom(FName : String) : Boolean ;πVar  InF  : Text ;                      { Input File                       }π     Buf  : Array[1..2048] Of Byte ;    { Speed-up Text buffer             }π     Lig  : String ;                    { Read line                        }π     Wrd  : String ;                    { Word gotten from parsed Lig      }π     WSt  : TWordString ;               { Checked version of Wrd           }π     p    : Integer ;                   { Work                             }π     Cnt  : LongInt ;                   { Line counter                     }πbeginπ     ReadWordsFrom:=False ;             { 'till now, at least !            }π     WordsList:=New(PWordCollection, Init(20, 20)) ;π     Assign(InF, FName) ;π     {$i-}π     ReSet(InF) ;π     {$i+}π     If IOResult<>0 Then Exit ;π     SetTextBuf(InF, Buf, SizeOf(Buf)) ;π     Cnt:=0 ;ππ     While Not EOF(InF) Doπ     beginπ          Inc(Cnt) ;π          ReadLn(InF, Lig) ;π          While Lig<>'' Doπ          beginπ               { Let's parse the read line into Words }π               p:=Pos(',', Lig) ;π               If p=0 Then p:=Length(Lig)+1 ;π               Wrd:=Copy(Lig, 1, p-1) ;π               { Check of overflowing Word length }π               If Length(Wrd)>MaxWordLen Thenπ                    WriteLn('Word length > ', MaxWordLen, ' : ', Wrd) ;π               WSt:=Wrd ;π               CleanUp(WSt) ;π               If WSt<>'' Then WordsList^.Insert(New(PWord, Init(WSt))) ;π               Delete(Lig, 1, p) ;π          end ;π     end ;π     {$i-}π     Close(InF) ;π     {$i+}π     If IOResult<>0 Then ;π     ReadWordsFrom:=True ;ππ     WriteLn(Cnt, ' lines, ', WordsList^.Count, ' Words found.') ;πend ;ππProcedure CheckAnagrams(i : Integer) ;π{ This Procedure builds, if necessary (i.e. not already done), the anagramsπ  list For Word #i of the list. }πVar  Org  : PWord ;                     { Original Word (1st of list)      }π     j    : Integer ;                   { Work                             }π     Last : PWord ;                     { Last anagram found               }πbeginπ     Org:=WordsList^.Items^[i] ;π     If Org^.FirstAng<>Nil Thenπ     beginπ          { This Word is already known to be the anagram of at least anotherπ            one ; don't re-do the job. }π          { _or_ this Word is known to have no anagrams in the list }π          Exit ;π     end ;ππ     { Search anagrams }π     Last:=Org ;π     Org^.FirstAng:=Org ;               { This Word is the first of it's   }π                                        { own anagrams list ; normal, no ? }π     For j:=Succ(i) To Pred(WordsList^.Count) Doπ     { Don't search the begining of the list, of course ! }π     beginπ          { Let's skip anagram checking if lengths are <> }π          If Org^.It[0]=PWord(WordsList^.Items^[j])^.It[0] Thenπ          If AreAnagrams(Org^.It, PWord(WordsList^.Items^[j])^.It) Thenπ          beginπ               { Build chained list of anagrams }π               Last^.NextAng:=WordsList^.Items^[j] ;π               Last:=WordsList^.Items^[j] ;π               Last^.FirstAng:=Org ;π          end ;π     end ;π     Last^.NextAng:=Nil ;               { Unusefull, but keep carefull     }πend ;ππProcedure ScanForAnagrams ;π{ This Procedure scans the list of Words For anagrams, and do the outputingπ  to the 'ANAGRAM.RES' File. }ππVar  i         : Integer ;              { Work                             }π     Tmp       : PWord ;                { Temporary Word                   }π     Out       : Text ;                 { Output File                      }π     Comma     : Boolean ;              { Helps dealing With commas        }π     Current   : PWord ;                { Currently handled Word           }πbeginπ     Assign(Out, OutFileName) ;π     ReWrite(Out) ;ππ     With WordsList^ Doπ     For i:=0 To Pred(Count) Doπ     beginπ          Current:=Items^[i] ;π          CheckAnagrams(i) ;π          { We're now gonna scan the chained list of known anagrams forπ            this Word. }π          If (Current^.NextAng<>Nil) Or (Current^.FirstAng<>Current) Thenπ          { This Word has at least an anagram other than itself }π          beginπ               Write(Out, PadStr(Current^.It, 12)) ;π               Inc(CntAnagrams) ;π               Comma:=False ;π               Tmp:=Current^.FirstAng ;π               While Tmp<>Nil Doπ               beginπ                    If Tmp<>Current Then { Don't reWrite it... }π                    beginπ                         If Comma Then Write(Out, ', ') ;π                         Comma:=True ;π                         Write(Out, Tmp^.It) ;π                         Inc(CntAnagrams) ;π                    end ;π                    Tmp:=Tmp^.NextAng ;π               end ;π               WriteLn(Out) ;π          end ;π     end ;ππ     Close(Out) ;πend ;ππVar  Tmp       : LongInt ;ππbeginπ  { Check command line parameter }ππ  If ParamCount<>1 Thenπ  beginπ    WriteLn('Anagram. Raphaël Vanney, 01/93 - Anagram''s contest entry.');π    WriteLn ;π    WriteLn('Anagram <input_File>') ;π    WriteLn ;π    WriteLn('Please specify input File name.') ;π    Halt(1) ;π  end ;ππ  OrgMem:=MemAvail ;ππ  { Read Words list from input File }ππ  If Not ReadWordsFrom(ParamStr(1)) Thenπ  beginπ       WriteLn('Error reading Words from input File.') ;π       Halt(1) ;π  end ;ππ  { Display statistics stuff }ππ  WriteLn('Reading and sorting done.') ;π  UsedMem:=OrgMem-MemAvail ;π  WriteLn('Used RAM                       : ', UsedMem, ' Bytes') ;π  Tmp := Trunc(1.0 * MemAvail / (1.0 * UsedMem / WordsList^.Count)) ;π  If Tmp > 16383 Thenπ    Tmp := 16383 ;π  WriteLn('Potential Words manageable     : ', Tmp) ;ππ  { Scan For anagrams, create output File }ππ  ScanForAnagrams ;π  WriteLn('Anagrams scanning & output done.') ;π  WriteLn(CntAnagrams, ' Words written to ', OutFileName) ;ππ  { Clean-up }π  Dispose(WordsList, Done) ;πend.π{ππ------------------------------------------------------------------------------ππOkay, this is my entry For the 'anagram contest' !ππThe few things I'd like to point-out about it :ππ. I chosed to use OOP, in contrast to seeking speed. I wouldn't say myπ  Program is Really slow (7.25 secs on my 386-33), but speed was not myπ  first concern.π. It fully Uses one of the interresting points of OOP in TP, i.e.π  reusability, through inheritance,π. When a Word (A) has been found to be an anagram of another (B), theπ  Program never searches again For the anagrams of (A) ; thisπ  highly reduces computing time... but I believe anybody does the same.π. I also quite like the assembly langage Function 'AreAnagrams'.ππ------------------------------------------------------------------------------ππThe Words list is stored in memory in the following maner :π. A collection (say, a list) of the Words,π. Within this list, anagrams are chained as a listπ. Each Word knows the first and the next of its anagramsππ------------------------------------------------------------------------------ππFor the sake of speed, I did something I'm quite ashamed of ; but itπsaves 32% of execution time, so...πThe usual way to access element #i of a TCollection is to call Function Atπwith parameter i (i.e. At(i)) ; there is also another way, which is not Reallyπclean, but which I chosed to use : access it directly through Items^[i].π                                                                                                                               4      05-28-9313:57ALL                      SWAG SUPPORT TEAM        BUBBLE1.PAS              IMPORT              6      S└Q {π> Does anyone know of a routine or code that would allow For aπ> alphabetical sort?ππDepends on what Type of sorting you want to do- For a very small list, aπsimple BubbleSort will suffice.π}πConstπ  max = 50;πVarπ  i,j:Integer;π  a : Array[1..max] of String;π  temp : String;πbeginπ  For i := 1 to 50 doπ    For j := 1 to 50 doπ      if a[i] < a[j] thenπ      beginπ        temp := a[i];π        a[i] := a[j];π        a[j] := temp;π      end;  { if }πend.ππ{πIf it's a bigger list than, say 100 or so elements, or it needs to beπsorted often, you'll probably need a better algorithm, like a shell sortπor a quicksort.π}ππ                5      05-28-9313:57ALL                      SWAG SUPPORT TEAM        BUBBLE2.PAS              IMPORT              8      S═M {π> Does anyone know of a routine or code that would allow forπ> a alphbetical sort in pascal?  If so could you mail orπ> Write it in this base?  Thanks!ππI know of a couple but this is the best and fastest one that I know ofππBubble Sortπ}ππTypeπ  StArray = Array [1..10] of String;ππProcedure bubble_sort(Var names : StArray);πVarπ  i,π  last,π  latest : Integer;π  temp : String;π  exchanged : Boolean;πbeginπ  last := max_names - 1;π  Repeatπ    i := 1;π    exchanged := False;π    latest    := last;π    Repeatπ      if names[i] > names[i+1] thenπ      beginπ        temp := names[i];π        names[i] := names[i+1];π        names[i+1] := temp;π        exchanged := True;π        latest := i;π      end;π      inc(i);π    Until not (i <= last);π    last := latest;π  Until not ((last >= 2) and exchanged);πend;π                                                                                6      05-28-9313:57ALL                      SWAG SUPPORT TEAM        COMB1.PAS                IMPORT              11     SO{ {π>Has anyone successfully converted the Combsort algorithm (I think it wasπ>published in DDJ or Byte about two years ago) from C to Pascal?  I'veπ>lost the original C source For this, but if anyone has any info, I wouldπ>appreciate it.π}ππProgram TestCombSort; { Byte magazine, April '91 page 315ff }πConstπ  Size = 25;πTypeπ  SortType = Integer;πVarπ  A: Array [1..size] of SortType;π  i: Word;ππProcedure CombSort (Var Ain);πVarπ  A: Array [1..Size] of SortType Absolute Ain;π  Switch: Boolean;π  i, j, Gap: Word;π  Hold: SortType;πbeginπ  Gap := Size;π  Repeatπ    Gap := Trunc (Gap / 1.3);π    if Gap < 1 thenπ      Gap := 1;π    Switch := False;π    For i := 1 to Size - Gap doπ    beginπ      j := i + Gap;π      if A [i] > A [j] then { swap }π      beginπ        Hold := A [i];π        A [i] := A [j];π        A [j] := Hold;π        Switch := True;;π      end;π    end;π  Until (Gap = 1) and not Switch;πend;ππbeginπ  Randomize;π  For i := 1 to Size doπ    A [i] := Random (32767);π  WriteLn;π  WriteLn ('Unsorted:');π  For i := 1 to Size doπ    Write (A [i]:8);π  WriteLn;π  CombSort (A);π  WriteLn ('Sorted:');π  For i := 1 to Size doπ    Write (A [i]:8);π  WriteLn;πend.π                                                                                                  7      05-28-9313:57ALL                      SWAG SUPPORT TEAM        COUNT1.PAS               IMPORT              16     Séâ {π  ...Well, as Greg Vigneault reminded me, there is a much fasterπ  method of sorting this sort of data called a "Count" sort. Iπ  often overlook this method, as it doesn't appear to be a sortπ  at all at first glance:π}πProgram Count_Sort_Demo;ππConstπ  co_MaxItem = 200;ππTypeπ  byar_MaxItem = Array[1..co_MaxItem] of Byte;π  byar_256     = Array[0..255] of Byte;ππVarπ  by_Index   : Byte;π  wo_Index   : Word;π  DataBuffer : byar_MaxItem;π  SortTable  : byar_256;ππbeginπ           (* Initialize the pseudo-random number generator.       *)π  randomize;ππ           (* Clear the CountSort table.                           *)π  fillChar(SortTable, sizeof(SortTable), 0);ππ           (* Create random Byte data.                             *)π  For wo_Index := 1 to co_MaxItem doπ    DataBuffer[wo_Index] := random(256);ππ           (* Display random data.                                 *)π  Writeln;π  Writeln('RANDOM Byte DATA');π  For wo_Index := 1 to co_MaxItem doπ    Write(DataBuffer[wo_Index]:4);ππ           (* CountSort the random data.                           *)π  For wo_Index := 1 to co_MaxItem doπ    inc(SortTable[DataBuffer[wo_Index]]);ππ           (* Display the CountSorted data.                        *)π  Writeln;π  Writeln('COUNTSORTED Byte DATA');π  For by_Index := 0 to 255 doπ    if (SortTable[by_Index] > 0) thenπ      For wo_Index := 1 to SortTable[by_Index] doπ        Write(by_Index:4)πend.π{π  ...This Type of sort is EXTEMELY fast, even when compared toπ  QuickSort, as there is so little data manipulation being done.ππ>BTW, why are there so many different sorting methods?π>Quick, bubble, Radix.. etc, etcππ  ...Because, Not all data is created equally.π  (ie: Some Types of sorts perform well on data that is veryπ       random, While other Types of sorts perform well on dataπ       that is "semi-sorted" or "almost sorted".)ππ}                                                    8      05-28-9313:57ALL                      SWAG SUPPORT TEAM        COUNT2.PAS               IMPORT              34     S÷\ {π>I'm in need of a FAST way of finding the largest and the smallestπ>30 numbers out of about 1000 different numbers.π> ...Assuming that the 1000 numbers are in random-order, I imagineπ> that the simplest (perhaps fastest too) method would be to:π>    1- Read the numbers in an Array.π>    2- QuickSort the Array.π>    3- First 30 and last 30 of Array are the numbers you want.π>  ...Here's a QuickSort demo Program that should help you With theπ>  sort: ...ππ Stop the presses, stop the presses!ππ Remember the recent Integer sort contest, on the Intelec Programmingπ conference?  The fastest method was a "counting" sort technique, whichπ used the Integers (to be sorted) as indexes of an Array.ππ You asked John Kuhn how it worked, as his example code was in messyπ C.  I sent you an explanation, along With example TP source.  Aroundπ that time my link to Intelec was intermittently broken; I didn'tπ hear back from you - so you may not have received my message (datedπ Jan.02.1993).  I hope you won't mind if I re-post it here and now...ππ In a message With John Kuhn...π> Simply toggle the sign bit of the values beFore sorting. Everythingπ> falls into place appropriately from there.π>  ...OK, but how about toggling them back to their originalπ>  state AFTER sorting? (I want to maintain negative numbers)π>  How can you tell which data elements are negative numbers???ππ Hi Guy,ππ if you've got all of this under your belt, then please disregardπ the following explanation ...ππ By toggling the high bit, the Integers are changed in a way that,π conveniently, allows sorting by magnitude: from the "most negative"π to "most positive," left to right, using an Array With unsignedπ indexes numbering 0...FFFFh.  The Array size represents the numberπ of all possible (16-bit) Integers... -32768 to 32767.ππ The "Count Sort" involves taking an Integer, toggling its high bitπ (whether the Integer is originally positive or negative), thenπ using this tweaked value as an index into the Array.  The tweakedπ value is used only as an Array index (it becomes an unsignedπ index somewhere within 0..FFFFh, inclusive).ππ The Array elements, which are initialized to zero, are simply theπ counts of the _occurrences_ of each Integer.  The original Integers,π With proper sign, are _derived_ from the indexes which point toπ non-zero elements (after the "sort")... ie. an original Integer isπ derived by toggling the high bit of a non-zero element's index.ππ Array elements of zero indicate that no Integer of the correspondingπ (derived) value was encountered, and can be ignored.  if any elementπ is non-zero, its index is used to derive the original Integer.  ifπ an Array element is greater than one (1), then the correspondingπ Integer occurred more than once.ππ A picture is worth 1000 Words:  The following simplified exampleπ sorts some negative Integers.  The entire Count Sort is done byπ a Single For-do-inC() loop - hence its speed.  The xors do theπ required high-bit toggling ...π}πππProgram DemoCountSort; { Turbo Pascal Count Sort.  G.Vigneault }ππ{ some negative Integers to sort ... }πConstπ  SomeNegs        : Array [0..20] of Integer =π                       (-2,-18,-18,-20000,-100,-10,-8,-11,-5,π                        -1300,-17,-1,-16000,-4,-12,-15,-19,-1,π                        -31234,-6,-7000 );ππ{ pick an Array to acComplish Count Sort ... }πVarπ  NegNumArray     : Array [$0000..$7FFF] of Byte;π{ PosNumArray     : Array [$8000..$FFFF] of Byte;            }π{ AllNumArray     : Array [$0000..$FFFF] of Byte;  use heap  }π  Index           : Word;π  IntCount        : Byte;ππbeginπ  { Initialize }π  FillChar( NegNumArray, Sizeof(NegNumArray), 0 );ππ  { Count Sort (the inC does this) ... }ππ  For Index := 0 to 20 doπ    { Just 21 negative Integers to sort }π    inC( NegNumArray[ Word(SomeNegs[Index] xor $8000) ]);ππ  { then display the sorted Integers ... }π  For Index := 0 to $7FFF doπ    { Check each Array element }π    For IntCount:= 1 to NegNumArray[Index] doπ      { For multiples }π      WriteLn( Integer(Index xor $8000) ); { derive value }ππend { DemoCountSort }.π                                                                                                                      9      05-28-9313:57ALL                      PEDRO DUARTE             Elevator Sort            IMPORT              15     SMb {π>   Thanks For the code...   It worked great!  BTW, why are there so manyπ>   different sorting methods?  Quick, bubble, Radix.. etc, etcππYes, there are lots of sorting algorithms out there! I also found this outπthe hard way! :-) A couple of years ago, I only knew the so-called "bubble"πsort, and decided to create my own sorting algorithm. It would have to beπfaster than bubble, yet remaining small, simple, and not memory hungry.πand I did it, but only to find out a few weeks later that there were muchπbetter sorts than the one I created... But it sure was great fun beatingπbubble! (which is brain-dead anyway! ;-)ππSo here it is, my two cents to the history of sorting algorithms, theπamazing, blazingly fast (*)... ELEVAtoR SorT!... Why ELEVAtoR??, you ask inπunison! Because it keeps going up & down! :-)π}ππProgram mysort;ππUses Crt;ππConstπ  max = 1000;ππTypeπ  list = Array[1..max] of Word;ππVarπ  data  : list;π  dummy : Word;πππProcedure elevatorsort(Var a: list; hi: Word);ππVarπ  lo,π  peak,π  temp,π  temp2 : Word;ππbeginπ  peak := 1;π  lo   := 1;π  Repeatπ    temp  := a[lo];π    temp2 := a[lo + 1];π    if temp > temp2 thenπ    beginπ      a[lo]     := temp2;π      a[lo + 1] := temp;π      if lo <> 1 then dec(lo);π    endπ      elseπ    beginπ      inc(peak);π      lo:=peak;π    end;π  Until lo = hi;πend;πππbeginπ  ClrScr;π  Writeln('Generating ', max ,' random numbers...');π  randomize;π  For dummy:=1 to max do data[dummy]:=random(65535);π  Writeln('Sorting random numbers...');π  elevatorsort(data,max);π  For dummy:=1 to max do Write(data[dummy]:5,'   ');πend.ππ{π(*) it's speed lies somewhere between "BUBBLE" and "inSERT"; it's muchπfaster than "BUBBLE", and a little slower than "inSERT"... :-)π}π                                                           10     05-28-9313:57ALL                      SWAG SUPPORT TEAM        ELEVATR2.PAS             IMPORT              11     Såc {π>Why can't Borland come out With a Universal sort since they made theπ>Program.. <G>ππI guess there's no such thing as a "universal" sort... There are a few veryπgood sorting algorithms, and depending on some factors, you just have toπchoose the one that best fits your needs!ππHere's an update to my ELEVAtoR sort, this one's even faster!π}ππProgram mysort;ππUses Crt;ππConstπ  max = 1000;ππTypeπ  list = Array[1..max] of Word;ππVarπ  data  : list;π  dummy : Word;πππProcedure elevatorsort(Var a: list; hi: Word);ππVarπ  dummy,π  low,π  peak,π  temp,π  temp2  : Word;ππbeginπ  peak   := 1;π  low    := 1;π  temp2  := a[low + 1];π  Repeatπ    temp  := a[low];π    if temp > temp2 thenπ    beginπ      a[low]     := temp2;π      a[low + 1] := temp;π      if low <> 1 then dec(low);π    endπ      elseπ    beginπ      inc(peak);π      low:=peak;π      if low <> hi then temp2:=a[low + 1];π    end;π  Until low = hi;πend;ππbeginπ  ClrScr;π  Writeln('Generating ', max ,' random numbers...');π  randomize;π  For dummy:=1 to max do data[dummy]:=random(65535);π  Writeln('Sorting random numbers...');π  elevatorsort(data,max);π  For dummy:=1 to max do Write(data[dummy]:5,'   ');πend.π                                                                                                   11     05-28-9313:57ALL                      SWAG SUPPORT TEAM        IMROVSRT.PAS             IMPORT              20     S╛= {πMARK OUELLETππ> I code these things this way:π>π> for I := 1 to MAX-1 doπ> for J := I+1 to MAX doπ> if A[I] < A[J] thenπ> beginπ> ( swap code )π> endππ    this can be improved even more. By limiting the MAX value on eachπsuccessive loop by keeping track of the highest swaped pair.ππ    If on a particular loop, no swap is performed from element MAX-10πonto the end. Then the next loop does not need to go anyhigher thanπMAX-11. Remember you are moving the highest value up, if no swap isπperformed from MAX-10 on, it means all values above MAX-11 are in orderπand all values below MAX-10 are smaller than MAX-10.π}ππ{$X+}πprogram MKOSort;ππUSESπ  Crt;ππConstπ  MAX = 1000;ππvarπ  A : Array[1..MAX] of word;π  Loops : word;ππprocedure Swap(Var A1, A2 : word);πvarπ  Temp : word;πbeginπ  Temp := A1;π  A1   := A2;π  A2   := Temp;πend;ππprocedure working;πconstπ  cursor : array[0..3] of char = '\|/-';π  CurrentCursor : byte = 1;π  Update : word = 0;πbeginπ  update := (update + 1) mod 2500;π  if update = 0 thenπ  beginπ    DirectVideo := False;π    write(Cursor[CurrentCursor], #13);π    CurrentCursor := ((CurrentCursor + 1) mod 4);π    DirectVideo := true;π  end;πend;ππprocedure Bubble;πvarπ  Highest,π  Limit, I  : word;π  NotSwaped : boolean;πbeginπ  Limit := MAX;π  Loops := 0;π  repeatπ    I := 1;π    Highest := 2;π    NotSwaped := true;π    repeatπ      working;π      if A[I] > A[I + 1] thenπ      beginπ        Highest := I;π        NotSwaped := False;π        Swap(A[I], A[I + 1]);π      end;π      Inc(I);π    until (I = Limit);π    Limit := Highest;π    Inc(Loops);π  until (NotSwaped) or (Limit <= 2);πend;ππprocedure InitArray;πvarπ  I, J : word;π  Temp : word;πbeginπ  randomize;π  for I := 1 to MAX doπ    A[I] := I;π  for I := MAX - 1 downto 1 doπ  beginπ    J := random(I) + 1;π    Swap(A[I + 1], A[J]);π  end;πend;ππprocedure Pause;πbeginπ  writeln;π  writeln('Press any key to continue...');π  while keypressed doπ    readkey;π  while not keypressed do;π  readkey;πend;ππprocedure PrintOut;πvarπ  I : word;πbeginπ  ClrScr;π  For I := 1 to MAX doπ  beginπ    if WhereY >= 22 thenπ    beginπ      Pause;π      ClrScr;π    end;π    if (WhereX >= 70) thenπ      Writeln(A[I] : 5)π    elseπ      Write(A[I] : 5);π  end;π  writeln;π  Pause;πend;ππbeginπ  ClrScr;π  InitArray;π  PrintOut;π  Bubble;π  PrintOut;π  writeln;π  writeln('Took ', Loops, ' Loops to complete');πend.π                                      12     05-28-9313:57ALL                      SWAG SUPPORT TEAM        MODHEAP.PAS              IMPORT              39     Svº {πOk, here is your "fastest sort routine." I spent a couple hours just tweakingπand testing to make sure that it was performing 100%.ππAdding $G+ only yielded a very slight speed increase but a noticeable one. (Theπspeed results below are based on $G-.) Using anything other than Integer forπVariables caused a slight degredation in performance. I would guess thatπInteger arithmetic is where Borland focused its optimizations on. Word andπLongInt all caused performance degredation.ππAND, it used to be that previous to v6 or v5.5 that multiplication was a bottleπneck too, as in J := I * 3; The faster method was to say J := I+I+I; sinceπaddition is faster than multiplication. I didn't see any appreciable differenceπwith respect to multiplication over addition here.ππThe following algorithm is a modified Fibonacci Heap sort With the addition ofπa mid-sort bounce technique. It runs almost twice the speed of the Quick Sortπalgorithm as posted in my last message.ππIt Uses considerably less stack then Quick Sort since it is non-recursive. And,πfor those of you who hate GOTO's, there's three in this code. Any other way Iπcould think of would increase data and reduce performance. But you're certainlyπwelcome to jump in and knock 'em outa there if you can!ππHere are the speed results as tested on 386-40mhz:ππ     500 Elements - (Less than 1/10 second)π    1000 Elements - 0.1 Secondsπ    1500 Elements - 0.2 Secondsπ    2000 Elements - 0.3 Secondsπ    5000 Elements - 1.0 Secondsπ    7500 Elements - 1.7 Secondsπ   10000 Elements - 2.3 SecondsππI modified the skeleton Program slightly to increase the number of 10 CharacterπStrings to 10,000 so that I could test that far.ππHere is the source code For the algorithm. Just "Plug" it into the skeletonπProgram I posted a day or so ago.ππ{------------------------------------------------------------------------}πProcedure ModHeapSort( Total : Integer );πVarπ  I,J,K,L : Integer;π  X, Temp : Pointer;π  M,M1,M2 : Integer;ππ  Label JumpOut;π  Label Terminate;π  Label SmallSort;ππbeginπ  if Total <= 4 Thenπ    Goto SmallSort; { Too small For Split sorting }ππ  M  := Pred(Total) div 3;π  M1 := ( M * 3 ) + 2;ππ  if M1 <= Total Thenπ  beginπ    if M1 < Total Thenπ      if SortArray[M1]^ < SortArray[Total]^ Thenπ        M2 := Totalπ      ELSEπ        M2 := M1π    ELSEπ      M2 := M1;ππ    if SortArray[1]^ < SortArray[M2]^ Thenπ    begin   { Swap first element to M2 }π      Temp          := SortArray[1];π      SortArray[1]  := SortArray[M2];π      SortArray[M2] := Temp;π    end;ππ  end; {IF M1 <= Total}ππ  For L := M DownTo 1 DOπ  beginπ    X := SortArray[L];π    I := L;π    J := I * 3;ππ    Repeatππ      K := Pred(J);ππ      if SortArray[K]^ < SortArray[J]^ Thenπ        K := J;π      if SortArray[K]^ < SortArray[Succ(J)]^ Thenπ        K := Succ(J);ππ      SortArray[I] := SortArray[K];π      I := K;π      J := I * 3;ππ    Until J > M1;ππ    J := Succ(I) div 3;ππ    Repeatππ      if SortArray[J]^ >= SmallArrPtr(X)^ Thenπ        Goto JumpOut;ππ      SortArray[I] := SortArray[J];π      I := J;π      J := Succ(J) div 3;ππ    Until J < L;ππ    JumpOut:π      SortArray[I] := X;ππ  end;ππ  For L := M1 To Total DOπ  beginπ    X := SortArray[L];π    I := L;π    J := Succ(I) div 3;ππ    if SortArray[J]^ < SmallArrPtr(X)^ Thenπ    beginππ      Repeatπ        SortArray[I] := SortArray[J];π        I := J;π        J := Succ(J) div 3;π      Until SortArray[J]^ >= SmallArrPtr(X)^;ππ      SortArray[I] := X;ππ    end; {IF}π  end; {For}ππ  L := Total;ππ  While L > 4 DOπ  beginπ    X := SortArray[L];π    SortArray[L] := SortArray[1];π    Dec(L,1);π    I := 1;π    J := 3;ππ    Repeatπ      K := Pred(J);ππ      if SortArray[K]^ < SortArray[J]^ Thenπ        K := J;π      if SortArray[K]^ < SortArray[Succ(J)]^ Thenπ        K := Succ(J);ππ      SortArray[I] := SortArray[K];π      I := K;π      J := I * 3;π    Until J >= L;ππ    Dec(J,1);ππ    if J <= L Thenπ    beginπ      if J < L Thenπ        if SortArray[J]^ < SortArray[L]^ Thenπ          J := L;π      SortArray[I] := SortArray[J];π      I := J;π    end; {IF}ππ    J := Succ(I) div 3;ππ    if SortArray[J]^ < SmallArrPtr(X)^ Thenπ    Repeatπ      SortArray[I] := SortArray[J];π      I := J;π      J := Succ(J) div 3;π    Until SortArray[J]^ >= SmallArrPtr(X)^;ππ    SortArray[I] := X;π  end;ππ  { Process last four remaining elements, or less than 4 to sort }π  { Use "Insertion sort" method For best linear time performance }ππ  SmallSort :π    if Total <= 4 Thenπ      L := Totalπ    ELSEπ      L := 4;ππ  For I := 2 To L DOπ  beginπ    X := SortArray[I];π    For J := Pred(I) DownTo 1 DOπ      if SortArray[J]^ > SmallArrPtr(X)^ Thenπ        SortArray[Succ(J)] := SortArray[J]π      ELSEπ        Goto Terminate;π    J := 0;ππ    Terminate : SortArray[Succ(J)] := X;ππ  end; {For I}πend;π                                                       13     05-28-9313:57ALL                      SWAG SUPPORT TEAM        OOP-SORT.PAS             IMPORT              10     Su  {πWL> Say, would anyone know how-to sort a Record With 5 thingπ WL> in it one of which is "NAME"...I want to sort each Recordπ WL> in the Array by name and can't figure it out....my Arrayπ WL> name is LabelS and my Record name is SofT....so any helpπ WL> would greatly be appreciated...thanksππThe easiest way is to make it an Object, and put it in a TSortedCollection.πFor example:π}ππ  Typeπ    PMyrec = ^TMyrec;π    TMyrec = Object(tObject)π      name : String;π      other : Integer;π    end;ππ    TSortedRecs = Object(TSortedCollection)π      Function Compare(Key1,key2:Pointer):Integer; Virtual;π    end;ππ  Function TSortedRecs.Compare;π  Varπ    p1 : PMyrec Absolute Key1;π    p2 : PMyrec Absolute Key2;π  beginπ    if p1^.name < p2^.name thenπ      Compare := -1π    else if p1^.name = p2^.name thenπ      Compare := 0π    elseπ      Compare := 1;π  end;ππVarπ  rec : PMyrec;π  coll: TSortedRecs; beginπ  coll.init(100,10);   { Init to 100 Records, grow by 10s }ππ  While More_Records doπ  beginπ    new(rec,init);π    rec^.name := Get_Name;π    rec^.other:= Get_Other;π    coll.insert(rec);π  end;π                                            14     05-28-9313:57ALL                      REYNIR STEFANSSON        Pointer Sort             IMPORT              28     S8φ {πREYNIR STEFANSSONππSome time ago I wangled myself into a beta testing team For a floppyπdisk catalogger called FlopiCat. This is a rather BASIC (in more than oneπway) Program, but works well enough.ππThe built-in sorting routine was a bit quacked, so I wrote my ownπexternal sorter, which is both more versatile and faster (by far) than theπinternal one.ππ     Here it is, in Case someone can use the idea (and code):π}ππProgram FlopiSrt; { Sorts FlopiCat.Dat. }ππConstπ  Maximum = 6000; { I don't need that many meself... }π  FName   : String[12] = 'Flopicat.Dat';ππTypeπ  fEntry = Recordπ    n : Array[1..4] of Char;π    i : Array[1..35] of Char;π    d : Array[1..39] of Char;π  end;ππ  En1 = Array[1..78] of Char;π  En2 = Recordπ    n : Array[1..4] of Char;π    f : Array[1..9] of Char;π    e : Array[1..3] of Char;π    z : Array[1..8] of Char;π    t : Array[1..15] of Char;π    d : Array[1..39] of Char;π  end;ππ  En3 = Recordπ    f, d : Array[1..39] of Char;π  end;ππ  pEntry = ^fEntry;ππVarπ  Entry        : Array [1..Maximum] of pEntry;π  fc           : File of fEntry;π  Rev          : Boolean;π  LoMem        : Pointer;π  i,π  NumOfEntries : Integer;π  nfd          : Char;π  s            : String;ππFunction ToSwap(i, j : Integer) : Boolean;πVarπ  Swop : Boolean;πbeginπ  Swop := False;π  Case nfd OFπ    { Sorting by disk number: }π    'N' : if Entry[i]^.n > Entry[j]^.n thenπ            Swop := True;π    { Sorting by File information: }π    'I' : if Entry[i]^.i > Entry[j]^.i thenπ            Swop := True;π    { Sorting by description: }π    'D' : if Entry[i]^.d > Entry[j]^.d thenπ            Swop := True;π    { Sorting by all the String: }π    'A' : if En1(Entry[i]^) > En1(Entry[j]^) thenπ            Swop := True;π    { Sorting by File name only: }π    'F' : if En2(Entry[i]^).f > En2(Entry[j]^).f thenπ            Swop := True;π    { Sorting by File extension only: }π    'E' : if En2(Entry[i]^).e > En2(Entry[j]^).e thenπ            Swop := True;π    { Sorting by File size: }π    'Z' : if En2(Entry[i]^).z > En2(Entry[j]^).z thenπ            Swop := True;π    { Sorting by date/time stamp: }π    'T' : if En2(Entry[i]^).t > En2(Entry[j]^).t thenπ            Swop := True;π    { Sorting by disk number/File info block: }π    'B' : if En3(Entry[i]^).f > En3(Entry[j]^).f thenπ            Swop := True;π  end;π  ToSwap := Swop xor Rev;πend;ππ{ if I remember correctly, I settled on using shaker/shuttle sort. }πProcedure SortIt;πVarπ  i, j,π  pb, pf,π  pp, pt : Integer;π  t      : pEntry;ππ  Procedure SwapIt(i, j : Integer);π  beginπ    t := Entry[i];π    Entry[i] := Entry[j];π    Entry[j] := t;π  end;ππbeginπ  Write('0    entries processed.');π  i  := 0;π  pt := 2;π  pb := NumOfEntries;π  pf := 0;π  Repeatπ    pp := pt;π    Repeatπ      if ToSwap(pp - 1, pp) thenπ      beginπ        SwapIt(pp - 1, pp);π        pf := pp;π      end;π      Inc(pp);π    Until pp > pb;ππ    pb := pf - 1;π    j  := i;π    i  := NumOfEntries - (pb - pt + 2);π    if (i MOD 10) < (j MOD 10) thenπ      Write(#13, i);π    if pb < pt thenπ      Exit;π    pp := pb;ππ    Repeatπ      if ToSwap(pp - 1, pp) thenπ      beginπ        SwapIt(pp - 1, pp);π        pf := pp;π      end;π      Dec(pp);π    Until pp < pt;ππ    pt := pf + 1;π    j  := i;π    i  := NumOfEntries - (pb - pt + 2);π    if (i MOD 10) < (j MOD 10) thenπ      Write(#13, i);π  Until pb < pt;πend;ππ                                                                                      15     05-28-9313:57ALL                      SWAG SUPPORT TEAM        QUICK1.PAS               IMPORT              15     Sσú Unit Qsort;ππ{ππCopyright 1990 Trevor J CarlsenπAll rights reserved.ππAuthor:   Trevor J Carlsenπ          PO Box 568π          Port Hedland WA 6721π          πA general purpose sorting Unit.πππ}ππInterfaceππTypeπ  updown   = (ascending,descending);π  str255   = String;π  dataType = str255;     { the Type of data to be sorted }π  dataptr  = ^dataType;π  ptrArray = Array[1..10000] of dataptr;π  Arrayptr = ^ptrArray;π  πConst π  maxsize  : Word = 10000;π  SortType : updown = ascending;π πProcedure QuickSort(Var da; left,right : Word);ππ{============================================================================}πImplementationπ πProcedure swap(Var a,b : dataptr);  { Swap the Pointers }π  Var  t : dataptr;π  beginπ    t := a;π    a := b;π    b := t;π  end;π π    πProcedure QuickSort(Var da; left,right : Word);π  Varπ    d       : ptrArray Absolute da;π    pivot   : dataType;π    lower,π    upper,π    middle  : Word;ππ  beginπ    lower := left;π    upper := right;π    middle:= (left + right) div 2;π    pivot := d[middle]^;π    Repeatπ      Case SortType ofπ      ascending :  beginπ                     While d[lower]^ < pivot do inc(lower);π                     While pivot < d[upper]^ do dec(upper);π                   end;π      descending:  beginπ                     While d[lower]^ > pivot do inc(lower);π                     While pivot > d[upper]^ do dec(upper);π                   end;π      end; { Case }                    π      if lower <= upper then beginπ        { swap the Pointers not the data }π        swap(d[lower],d[upper]);π        inc(lower);π        dec(upper);π      end;π    Until lower > upper;π    if left < upper then QuickSort(d,left,upper);π    if lower < right then QuickSort(d,lower,right);π  end;  { QuickSort }ππend.πππ                         16     05-28-9313:57ALL                      SWAG SUPPORT TEAM        QUICK2.PAS               IMPORT              16     Sâ {...This is as generic a QuickSort as I currently use:π}π{$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,P-,R-,S-,T-,V-}π{$M 60000,0,0}ππProgram QuickSortDemo;πUsesπ  Crt;ππConstπ  coMaxItem = 30000;ππTypeπ  Item   = Word;π  arItem = Array[1..coMaxItem] of Item;ππ  (***** QuickSort routine.                                           *)π  (*                                                                  *)πProcedure QuickSort({update} Var arData  : arItem;π                      {input }     woLeft,π                                   woRight : Word);πVarπ  Pivot,π  TempItem : Item;π  woIndex1,π  woIndex2 : Word;πbeginπ  woIndex1 := woLeft;π  woIndex2 := woRight;π  Pivot := arData[(woLeft + woRight) div 2];π  Repeatπ    While (arData[woIndex1] < Pivot) doπ      inc(woIndex1);π    While (Pivot < arData[woIndex2]) doπ      dec(woIndex2);π    if (woIndex1 <= woIndex2) thenπ      beginπ        TempItem := arData[woIndex1];π        arData[woIndex1] := arData[woIndex2];π        arData[woIndex2] := TempItem;π        inc(woIndex1);π        dec(woIndex2)π      endπ    Until (woIndex1 > woIndex2);π    if (woLeft < woIndex2) thenπ      QuickSort(arData, woLeft, woIndex2);π    if (woIndex1 < woRight) thenπ      QuickSort(arData, woIndex1, woRight)πend;        (* QuickSort.                                           *)ππVarπ  woIndex : Word;π  Buffer  : arItem;ππbeginπ  Write('Creating ', coMaxItem, ' random numbers... ');π  For woIndex := 1 to coMaxItem doπ    Buffer[woIndex] := random(65535);π  Writeln('Finished!');π  Write('Sorting  ', coMaxItem, ' random numbers... ');π  QuickSort(Buffer, 1, coMaxItem);π  Writeln('Finished!');π  Writeln;π  Writeln('Press the <ENTER> key to display all ', coMaxItem,π          ' sorted numbers...');π  readln;π  For woIndex := 1 to coMaxItem doπ    Write(Buffer[woIndex]:8)πend.π                                                                                                            17     05-28-9313:57ALL                      TEK CHAN                 Quick Sort               IMPORT              13     S╨O { File that will teach me how to quick sort?  I know how quick sort worksπ but I don't know why my Program doesn't sort properaly.  Sometimes it goesπ through one cycle of sort and sometimes it goes through two cycles of sortπ but it never sorts it Completely! Tek ChanππHere is some generic source code, change it to suit your needs/Types:π}ππProcedure Split(Var Info: ArrayType; First: Integer; Last: Integer; VarπSplitPt1: Integer; Var SplitPt2: Integer);ππVar SplitVal, Temp: ArrayElementType;ππbeginπ  SplitVal:=Info[(First+Last) div 2];π  Repeatπ    While Info[First] < SplitVal doπ      First:=First+1;π    While Info[Last] > SplitVal doπ      Last:=Last-1;π    if First <= Last thenπ      beginπ        Temp:=Info[First];π        Info[First]:=Info[Last];π        Info[Last]:=Temp;π        First:=First+1;π        Last:=Last-1;π      endπ  Until First > Last;π  SplitPt1:=First;π  SplitPt2:=Last;πend;ππProcedure QuickSort(Var Info: ArrayType;  First:Integer;  Last: Integer);ππVar SplitPt1, SplitPt2: Integer;ππbeginπ  if First < Last thenπ    beginπ      Split(Info, First, Last, SplitPt1, SplitPt2);π      if SplitPt1 < Lastπ        then QuickSort(Info, SplitPt1, Last);π      if First < SplitPt2π        then QuickSort(Info, First, SplitPt2);π    endπend;ππ{πThis is a -very- fast sort, much faster than any other I have.  Does aπnon-recursive version exist?  Are there any faster sorts?   Brianπ}                                                                                                                                18     05-28-9313:57ALL                      SWAG SUPPORT TEAM        QUICK4.PAS               IMPORT              17     S⌠v Unit qsort;ππInterfaceππProcedure quicksort(Var s; left,right : Word);ππImplementationππProcedure quicksort(Var s; left,right : Word; SortType: sType);π  { On the first call left should always be = to min and right = to max }π  Varπ    data      : DataArr Absolute s;π    pivotStr,π    tempStr   : String;π    pivotLong,π    tempLong  : LongIntπ    lower,π    upper,π    middle    : Word;ππ  Procedure swap(Var a,b);π    Var x : DirRec Absolute a;π        y : DirRec Absolute b;π        t : DirRec;π    beginπ      t := x;π      x := y;π      y := t;π    end;ππ  beginπ    lower := left;π    upper := right;π    middle:= (left + right) div 2;π    Case SortType ofπ      _name: pivotStr   := data[middle].name;π      _ext : pivotStr   := data[middle].ext;π      _size: pivotLong  := data[middle].Lsize;π      _date: pivotLong  := data[middle].Ldate;π    end; { Case SortType }π    Repeatπ      Case SortType ofπ        _name: beginπ                 While data[lower].name < pivotStr do inc(lower);π                 While pivotStr < data[upper].name do dec(upper);π               end;π        _ext : beginπ                 While data[lower].ext < pivotStr do inc(lower);π                 While pivotStr < data[upper].ext do dec(upper);π               end;π        _size: beginπ                 While data[lower].Lsize < pivotLong do inc(lower);π                 While pivotLong < data[upper].Lsize do dec(upper);π               end;π        _date: beginπ                 While data[lower].Ldate < pivotLong do inc(lower);π                 While pivotLong < data[upper].Ldate do dec(upper);π               end;π      end; { Case SortType }π      if lower <= upper then beginπ        swap(data[lower],data[upper]);π        inc(lower);π        dec(upper);π       end;π    Until lower > upper;π    if left < upper then quicksort(data,left,upper);π    if lower < right then quicksort(data,lower,right);π  end; { quicksort }ππππππππ                                                                                                                            19     05-28-9313:57ALL                      SWAG SUPPORT TEAM        QUICK5.PAS               IMPORT              19     SΦ, {π>I'm in need of a FAST way of finding the largest and the smallestπ>30 numbers out of about 1000 different numbers.ππ  ...Assuming that the 1000 numbers are in random-order, I imagineπ  that the simplest (perhaps fastest too) method would be to:ππ    1- Read the numbers in an Array.ππ    2- QuickSort the Array.ππ    3- First 30 and last 30 of Array are the numbers you want.ππ  ...Here's a QuickSort demo Program that should help you With theπ  sort:π}ππ{$A+,B-,D-,E-,F-,I-,L-,N-,O-,R-,S+,V-}π{$M 60000,0,0}ππProgram QuickSort_Demo;πUsesπ  Crt;ππConstπ  co_MaxItem = 30000;ππTypeπ  Item    = Word;π  ar_Item = Array[1..co_MaxItem] of Item;πππ  (***** QuickSort routine.                                           *)π  (*                                                                  *)πProcedure QuickSort({update} Var ar_Data  : ar_Item;π                    {input }     wo_Left,π                                 wo_Right : Word);πVarπ  Pivot,π  TempItem  : Item;π  wo_Index1,π  wo_Index2 : Word;πbeginπ  wo_Index1 := wo_Left;π  wo_Index2 := wo_Right;π  Pivot := ar_Data[(wo_Left + wo_Right) div 2];π  Repeatπ    While (ar_Data[wo_Index1] < Pivot) doπ      inc(wo_Index1);π    While (Pivot < ar_Data[wo_Index2]) doπ      dec(wo_Index2);π    if (wo_Index1 <= wo_Index2) thenπ      beginπ        TempItem := ar_Data[wo_Index1];π        ar_Data[wo_Index1] := ar_Data[wo_Index2];π        ar_Data[wo_Index2] := TempItem;π        inc(wo_Index1);π        dec(wo_Index2)π      endπ    Until (wo_Index1 > wo_Index2);π    if (wo_Left < wo_Index2) thenπ      QuickSort(ar_Data, wo_Left, wo_Index2);π    if (wo_Index1 < wo_Right) thenπ      QuickSort(ar_Data, wo_Index1, wo_Right)πend;        (* QuickSort.                                           *)ππVarπ  wo_Index  : Word;π  ar_Buffer : ar_Item;ππbeginπ  Write('Creating ', co_MaxItem, ' random numbers... ');π  For wo_Index := 1 to co_MaxItem doπ    ar_Buffer[wo_Index] := random(65535);π  Writeln('Finished!');π  Write('Sorting  ', co_MaxItem, ' random numbers... ');π  QuickSort(ar_Buffer, 1, co_MaxItem);π  Writeln('Finished!');π  Writeln;π  Writeln('Press the <ENTER> key to display all ', co_MaxItem,π          ' sorted numbers...');π  readln;π  For wo_Index := 1 to co_MaxItem doπ    Write(ar_Buffer[wo_Index]:8)πend.π                              20     05-28-9313:57ALL                      SWAG SUPPORT TEAM        RADIX1.PAS               IMPORT              34     SÇl {π   Here's my solution to your "contest". The first I'm rather proudπ   of, it incorporates bAsm to beat your devilshly efficient CASEπ   Implementation by a factor of 2x.ππ   The second, I am rather disappointed With as it doesn't even comeπ   CLOSE to TP's inbuilt STR Function. (The reason, I have found, isπ   because TP's implementaion Uses a table based approach that wouldπ   be hard to duplicate With Variable radixes. I am working on aπ   Variable radix table now)πππ  ****************************************************************π  Converts String pointed to by S into unsigned Integer V. Noπ  range or error checking is performed. Caller is responsible forπ  ensuring that Radix is in proper range of 2-36, and that noπ  invalid Characters exist in the String.π  ****************************************************************π}πTypeπ  pChar      = ^chr_Array;π  chr_Array  = Array[0..255] of Char;π  Byte_arry  = Array[Char] of Byte;ππConstπ  sym_tab : Byte_arry = (π              0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,π              0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,π              0,0,0,0,0,0,0,0,0,1,2,3,4,5,6,7,8,9,π              0,0,0,0,0,0,0,10,11,12,13,14,15,16,17,π              18,19,20,21,22,23,24,25,26,27,28,29,30,π              31,32,33,34,35,0,0,0,0,0,0,10,11,12,13,π              14,15,16,17,18,19,20,21,22,23,24,25,26,π              27,28,29,30,31,32,33,34,35,0,0,0,0,0,0,π              0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,π              0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,π              0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,π              0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,π              0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,π              0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,π              0,0,0,0,0,0,0,0,0,0,0,0,0π                        );ππProcedure RadixVal(Var V:LongInt; S:PChar;Radix:Byte);πVarπ  digit        :Byte;π  p,    p2     :Pointer;π  hiwd, lowd   :Word;πbeginπ  V  := 0;π  p  := @S^[0];π  p2 := @V;π  Asmπ    les  bx, p2π    push dsπ    pop  esπ    lds  si, pπ  @loop3:π    lea  di, [sym_tab]π    xor  ah, ahπ    lodsbπ    cmp  al, 0π    je   @quitπ    add  di, ax             { index to Char position in table }π    mov  al, Byte PTR [di]π    mov  digit, alπ    xor  ah, ahπ    mov  al, Radixπ    mov  cx, axπ    mul  Word PTR [bx]π    mov  lowd, axπ    mov  hiwd, dxπ    mov  ax, cxπ    mul  Word PTR [bx+2] { mutliply high Word With radix }π    add  hiwd, ax        { add result to previous result - assume hi result 0 }π    mov  ax, lowdπ    mov  dx, hiwdπ    add  al, digit     { add digit value }π    adc  ah, 0         { resolve any carry }π    mov  [bx], ax      { store final values }π    mov  [bx+2], dxπ    jmp  @loop3π  @quit:π  end;πend;ππ{π  ****************************************************************π  Convert unsigned Integer in V to String pointed to by S.π  Radix determines the base to use in the conversion. No rangeπ  checking is performed, the caller is responsible For ensuringπ  the radix is in the proper range (2-36), and that V is positive.π  ****************************************************************π}πTypeπ  Char_arry = Array[0..35] of Char;ππConstπ  symbols :Char_arry = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';ππProcedure RadixStr(V:LongInt; S:PChar; Radix:Byte);πVarπ  digit, c :Byte;π  ts       :String;π  p, p2    :Pointer;πbeginπ  c := 255;π  ts[255] := #0;π  p  := @V;π  p2 := @ts[0];π  Asmπ    push dsπ    lea  si, [symbols]π    les  bx, pπ    les  di, p2π    add  di, 255π    stdπ    xor  cx, cxπ    mov  cl, Radixπ  @loop:π  SEGES mov  ax, Word PTR [bx]π  SEGES mov  dx, Word PTR [bx+2]π    div  cxπ  SEGES mov  Word PTR [bx], axπ  SEGES mov  Word PTR [bx+2], 0π    mov  digit, dlπ    push siπ    xor  ah, ahπ    mov  al, digitπ    add  si, axπ    movsbπ    pop  siπ    dec  cπ  SEGES cmp  Word PTR [bx], 0π    je   @doneπ  SEGES cmp  Word PTR [bx+2], 0π    je   @loopπ  @done:π    pop  dsπ  end;π  ts[c] := Chr(255-c);π  p  := @S^[0];π  Asmπ    push dsπ    cldπ    lds  si, p2π    les  di, pπ    xor  bx, bxπ    mov  bl, cπ    add  si, bxπ    mov  cx, 256π    sub  cl, cπ    sbb  ch, 0π    rep movsbπ    pop  dsπ  end;πend;π                                                                          21     05-28-9313:57ALL                      SWAG SUPPORT TEAM        RADIX2.PAS               IMPORT              16     S╒^ {>...Assuming that the 1000 numbers are in random-order, I imagineπ> that the simplest (perhaps fastest too) method would be to:π>    1- Read the numbers in an Array.π>    2- QuickSort the Array.π>    3- First 30 and last 30 of Array are the numbers you want.ππ>Stop the presses, stop the presses!ππ  <grin>ππ>Remember the recent Integer sort contest, on the Intelecπ>Programming conference?ππ  ...Ah, yes... I always tend to Forget about that method.π  Yes, a "count" sort would definitely be the fastest methodπ  of sorting random numerical data.π  ...What I had a few troubles figuring out from that postπ  in the Intelec confrence, wasn't the "count sort" method,π  but rather the "radix sort" or "digital sort" method,π  where specific bits within each data element are usedπ  to sort the data.ππ  ...Here's the algorithm listed in Robert Sedgewick'sπ  "Algorithms" book, published by Addison-Wesley Publishingπ  Company, ISBN 0-201-06673-4 :π}ππProcedure RadixExchange(l, r, b:Integer);πVarπ  t, i, j : Integer;πbeginπ  if (r > l) and (b >= 0) thenπ  beginπ    i := l;π    j := r;π    Repeatπ      While (bits(a[i], b, 1) = 0) and (i < j) doπ        i := I + 1;π      While (bits(a[j], b, 1) = 1) and (i < j) doπ        j := j - j;π      t := a[i];π      a[i] := a;π      a[j] := t;π    Until (j = i);π    if bits(a[r], b, 1) = 0 thenπ      j := j + 1;π    RadixExchange(l, (j - 1), b - 1);π    RadixExchange(j, r, (b - 1));π  end;πend;ππ{π>By toggling the high bit, the Integers are changed in a way that,π>conveniently, allows sorting by magnitude: from the "most negative"π>to "most positive," left to right, using an Array With unsignedπ>indexes numbering 0...FFFFh.ππ  ...Why bother With the bit toggling at all? Why not just defineπ  the Array's range as being:  Array[-32768..32767] of Byte;π}ππ                                                                                                                22     05-28-9313:57ALL                      SWAG SUPPORT TEAM        RADIXQUE.PAS             IMPORT              16     S9á Turbo Pascal Optimization Contest # 51.ππNo tangible prizes, just some bragging rights, and a brain workout.ππAssignment:  Write conversion routines similar to VAL and STR that canπ             handle a radix (base) of any number.  For example, below isπ             a straight Pascal Procedure to convert a String of any baseπ             to a LongInt.  Can you improve the speed of this routine,π             and Write a correspondingly fast routine to convert from aπ             LongInt to a String of any base?ππRules:       No rules.  BAsm is allowed, as long as the Functions areπ             readily Compilable without the use of TAsm.ππJudging:     Code will be tested on a 386-40 on March 10th, by beingπ             placed into a loop With no output, like this:ππ               StartTiming;π               For Loop := 1 to 10000000 { ten million } doπ                 { Execute the test, no output }π               WriteLn(StopTiming);ππReady, set, code!  Here's the sample...ππ(* This Function converts an ASCIIZ String S in base Radix to LongInt Iπ * With no verification of radix validity.   The calling Programmer isπ * responsible For insuring that the radix range is 2 through 36.  Theπ * calling Programmer is also responsible For insuring that the passedπ * String contains only valid digits in the specified Radix. No checkingπ * is done on the individual digits of a given String.  For bases 11-36π * the letters 'A'-'Z' represent the corresponding values.π *)ππProcedure StrtoLong(Var I : LongInt; S : PChar; Radix : Integer);π  beginπ    I        := 0;π    While S[0] <> #0 doπ      beginπ        Case S[0] of '0'..'9' : I := I * Radix + (ord(S[0])-48);π                     'A'..'Z' : I := I * Radix + (ord(S[0])-54);π                     'a'..'z' : I := I * Radix + (ord(S[0])-86);π        Inc(s);π      end;π  end;ππ                                                                              23     05-28-9313:57ALL                      JOY MUKHERJEE            Radix Sort               IMPORT              24     SÇ^ {π> I agree... unFortunately the Radix algorithm (which is aπ> sophisticated modification of a Distribution Sort algorithm) isπ> very Complex, highly CPU dependent and highly data dependent.ππWe must be speaking of a different Radix Sort.  Is the sort you areπtalking about sort numbers on the basis of their digits?ππ> My understanding is that a Radix sort cannot be implemented inπ> Pascal without using a majority of Asm (which means you might asπ> well code the whole thing in Asm.)ππ> assembly) or dig up some working code, I would love to play With it!ππ************************************************************************π*                                                                      *π* Name : Joy Mukherjee                                                 *π* Date : Mar. 26, 1990                                                 *π* Description : This is the Radix sort implemented in Pascal           *π*                                                                      *π************************************************************************π}ππProgram SortStuff;ππUses Crt, Dos;ππTypeπ    AType = Array [1..400] of Integer;π    Ptr   = ^Node;π    Node  = Recordπ          Info : Integer;π          Link : Ptr;π        end;π    LType = Array [0..9] of Ptr;ππVarπ   Ran     : AType;π   MaxData : Integer;ππProcedure ReadData (Var A : AType; Var MaxData : Integer);ππVar I : Integer;ππbeginπ     MaxData := 400;π     For I := 1 to 400 do A [I] := Random (9999);πend;ππProcedure WriteArray (A : AType; MaxData : Integer);ππVar I : Integer;ππbeginπ  For I := 1 to MaxData doπ    Write (A [I] : 5);π  Writeln;πend;ππProcedure Insert (Var L : LType; Number, LN : Integer);ππVarπ  P, Q : Ptr;ππbeginπ  New (P);π  P^.Info := Number;π  P^.Link := Nil;π  Q := L [LN];π  if Q = Nil thenπ    L [LN] := Pπ  elseπ  beginπ    While Q^.Link <> Nil doπ      Q := Q^.Link;π    Q^.Link := P;π  end;πend;πππProcedure Refill (Var A : AType; Var L : LType);πVarπ  I, J : Integer;π  P    : Ptr;πbeginπ  J := 1;π  For I := 0 to 9 doπ  beginπ    P := L [I];π    While P <> Nil doπ    beginπ      A [J] := P^.Info;π      P := P^.Link;π      J := J + 1;π    end;π  end;π  For I := 0 to 9 doπ    L [I] := Nil;πend;ππProcedure RadixSort (Var A : AType; MaxData : Integer);πVarπ  L        : LType;π  I,π  divisor,π  ListNo,π  Number   : Integer;πbeginπ  For I := 0 to 9 do L [I] := Nil;π  divisor := 1;π  While divisor <= 1000 doπ  beginπ    I := 1;π    While I <= MaxData doπ    beginπ      Number := A [I];π      ListNo := Number div divisor MOD 10;π      Insert (L, Number, ListNo);π      I := I + 1;π    end;π    Refill (A, L);π    divisor := 10 * divisor;π  end;πend;ππbeginπ    ReadData (Ran, MaxData);π    Writeln ('Unsorted : ');π    WriteArray (Ran, MaxData);π    RadixSort (Ran, MaxData);π    Writeln ('Sorted   : ');π    WriteArray (Ran, MaxData);πend.π                                                                                 24     05-28-9313:57ALL                      SWAG SUPPORT TEAM        SHELL1.PAS               IMPORT              14     S*K {   Arrrggghh. I hate Bubble sorts. Why don't you use Merge sort? It's a hellπ of a lot faster and if you have a large enough stack, there wouldn't beπ any problems. if you were not interested in doing a recursive sort, thenπ here is an example fo the Shell sort which is one of the most efficientπ non recursive sorts around.π}πππConstπ    Max = 50;πTypeπ    ArrayType = Array[1..Max] of Integer;ππVarπ    Data, Temp    : ArrayType;π    Response      : Char;π    X, Iteration  : Integer;ππProcedure ShellSort (Var Data : ArrayType;Var Iteration : Integer;π                                            NumberItems : Integer);ππProcedure Sort (Var Data : ArrayType; Var Iteration : Integer;π                             NumberItems, Distance : Integer);ππVarπ   X, Y : Integer;ππbegin   {Sort}π   Iteration := 0;π   For Y := Distance + 1 to NumberItems Doπ      begin  {For}π         X := Y - Distance;π         While X > 0 Doπ            begin   {While}π               if Data[X+Distance] < Data[X] thenπ                  begin   {if}π                     Switch (Data[X+Distance], Data[X], Iteration);π                     X := X - Distance;π                     Iteration := Iteration + 1π                  end     {if}π               elseπ                  X := 0;π            end;    {While}π      end    {For}πend;    {Sort}ππbegin   {ShellSort}π   Distance := NumberItems div 2;π   While Distance > 0 doπ      begin   {While}π         Sort (Data, Iteration, NumberItems, Distance);π         Distance := Distance div 2π      end;    {While}πend;    {ShellSort}π                                                                                                   25     05-28-9313:57ALL                      SWAG SUPPORT TEAM        SOMESORT.PAS             IMPORT              18     Sú { Author: Brian Pape. }ππConstπ  maxrange = 5000;ππTypeπ  ListRange = 1..MaxRange;π  list = Array[ListRange] of Integer;ππVarπ  a,b: list;π  i: Integer;ππProcedure BubbleSort(Var B : list; Terms : Integer);πVarπ  J, Temp : Integer;π  Changed : Boolean;π  Last,π  LastSwitch : Integer;πbeginπ  changed := True;π  Last := Terms-1;π  While Changed doπ  beginπ    changed := False;π    For J := 1 to Last doπ      If B[J] > B[J+1] thenπ      beginπ        Temp := B[J];π        B[J] := B[J+1];π        B[J+1] := Temp;π        Changed := True;π        LastSwitch := j;π      end;  { If B[J] }π    Last := LastSwitch -1;π  end  { While Changed }πend;  { BubbleSort }ππProcedure Min_MaxSort(Var a : list;  NumberTerms : ListRange);πVarπ  temp,π  i,l,r,π  min,max,π  tempMin,π  tempMax,π  indexMin,π  indexMax,π  s1,s2,s3,s4 : Integer;π  changed     : Boolean;πbeginπ  l := 1;  r := NumberTerms;  max := MaxInt;π  Repeatπ    min := max;π    changed := False;π    max := 0;π    For i := l to r doπ    beginπ      if a[i] > max thenπ      beginπ        changed := True;π        Max := a[i];π        indexMax := i;π      end;  { if }π      if a[i] < min thenπ      beginπ        changed := True;π        Min := a[i];π        indexMin := i;π      end;  { if }π    end;  { For }ππ    tempMin := a[indexMin];π    tempMax := a[indexMax];π    a[indexMax] := a[l];π    a[l] := tempMin;π    a[indexMin] := a[r];π    a[r] := tempMax;π    inc(l);  dec(r);π  Until (l>=r) or not changed;πend;  { Min_MaxSort }πππProcedure ShellSort(Var a : list;  NumberTerms : ListRange);πConstπ  start = 1;π  increment = 3;  { division factor of terms }πVarπ  i,j   : ListRange;π  t     : Integer;π  found : Boolean;πbeginπ  i := start + increment;π  While i <= NumberTerms doπ  beginπ    if a[i] < a[i - increment] thenπ    beginπ      j := 1;π      t := a[i];π      Repeatπ        j := j - increment;π        a[j + increment] := a[j];π        if j = 1 thenπ          found := Trueπ        elseπ          found := a[j - increment] <= t;π      Until found;π      a[j] := t;π    end;  { if }π    i := i + increment;π  end;  { While }πend;  { ShellSort }π                                                           26     05-28-9313:57ALL                      SWAG SUPPORT TEAM        SORT-DLL.PAS             IMPORT              25     S╬ {π>         Now, I gotta work on sortin' em.  I believe I can 'swap' theπ>         positions of the Pointers eh?π>π>         I can't figure out how to swap the Pointers.  Could you pleaseπ>         gimme a wee bit more help?  I've just started doing sorts, andπ>         have only used the Bubble sort at the moment in a few Programs,π>         so I'm still a little shakey on sorts.  I understand the Bubbleππ  Here's an *example* on how to sort a linked list. There are moreπ  efficient ways to sort a list, but this gives you all theπ  essential elements in doing a sort. (note that ListPtr is a doublyπ  linked list)π}ππProcedure SortList(Var FCL:ListPtr);πVarπ  TempAnchor, TemPtr1, TemPtr2 :ListPtr;ππ  Procedure MoveLink(Var Anchor, Ptr1, Ptr2 :ListPtr);π  Varπ    TemPtr3, TemPtr4 :ListPtr;π  beginπ    TemPtr3 := Ptr1^.Next;   { temporary Pointer preserves oldπ                               Pointer value }π    TemPtr4 := Ptr2^.Last;   { ditto }ππ    Ptr2^.Last := Ptr1;          { do the Pointer swap }π    Ptr1^.Next := Ptr2;ππ    Ptr1^.Last^.Next := TemPtr3; { fixup secondary Pointers }π    TemPtr3^.Last := Ptr1^.Last;π    Ptr1^.Last := TemPtr4;ππ    if TemPtr4 <> NIL then       { if temporary Pointer is notπ                                   NIL, then it has to point toπ                                   swapped Pointer }π       TemPtr4^.Next := Ptr1;ππ    if Ptr1^.Last = NIL then     { if swapped Pointer points toπ                                   preceding NIL Pointer, thisπ                                   Pointer is the new root. }π       Anchor := Ptr1;π  end;ππbeginπ  TempAnchor := FCL;     { holds root of list during sort }π  TemPtr2 := TempAnchor; { TemPtr2 points to current data beingπ                           Compared }π  Repeatπ    TemPtr1 := TemPtr2; { TemPtr1 points to the next orderedπ                          data }π    FCL := TemPtr2;     { start FCL at root of UNSorTED list -π                          sorted data precede this Pointer }π    Repeatπ      FCL := FCL^.Next;π      if FCL^.data < TemPtr1^.data then   { Compare data values }π        TemPtr1 := FCL;         { if necessary, reset TemPtr1 toπ                                   point to the new ordered value }π    Until FCL^.Next = NIL;        { keep going Until you reach theπ                                    end of the list. After Exit,π                                    the next value in order will beπ                                    pointed to by TemPtr1 }π    if TemPtr1<>TemPtr2 then      { if TemPtr1 changed, a valueπ                                    was found out of order }π      MoveLink(TempAnchor,TemPtr1,TemPtr2) { then swap Pointers }π    elseπ      TemPtr2 := TemPtr2^.Next;  { else advance to the nextπ                                    Pointer in list }π  Until TemPtr2^.Next = NIL;      { Until we are finished sortingπ                                     the list }π  FCL := TempAnchor;    { changes root Pointer to new root value }πend;ππ                                                                                         27     05-28-9313:57ALL                      SWAG SUPPORT TEAM        SORT-LL.PAS              IMPORT              25     Sìf {π> I have a linked list structure that I would like to sort in one ofπ> four different ways.  I can sort Arrays using QuickSort, etc., but have noπ> experience sorting linked lists.  Does anyone have any source codeπ> (preferably) or any suggestions on how to proceed?  Any help would beπ> appreciated.ππI got Modula-2 code I wrote about one year ago. I post an excerpt fromπthe Implementation MODULE. It should be no problem to convert it toπPascal, since the languages are rather similar.π}πProcedure LISTSort(Var List     : LISTType;π                       Ascending: Boolean);ππVarπ  Last  : NodeTypePtr;π  Result: LISTCompareResultType;ππ  Procedure TailIns(    Rec  : NodeTypePtr;π                    Var First: NodeTypePtr;π                    Var Last : NodeTypePtr);ππ  beginπ    if (First=NIL) then First := Rec else Last^.Next := Rec end;π    Last := Recπ  end TailIns;ππ  Procedure MergeLists(    a: NodeTypePtr;π                           b: NodeTypePtr): NodeTypePtr;ππ  Varπ    First: NodeTypePtr;π    Last : NodeTypePtr;π    Help : NodeTypePtr;ππ  beginπ    First := NIL;π    While (b#NIL) doπ      if (a=NIL) thenπ        a := b; b := NILπ      elseπ        if (Classes[List^.ClassID].Cmp(b^.DataPtr,a^.DataPtr)=Result)π        thenπ          Help := a; a := a^.Nextπ        elseπ          Help := b; b := b^.Nextπ        end;π        Help^.Next := NIL;π        TailIns(Help,First,Last)π      endπ    end;π    TailIns(a,First,Last);π    RETURN(First)π  end MergeLists;ππ  Procedure MergeSort(Var Root: NodeTypePtr;π                          N   : CARDinAL): NodeTypePtr;ππ  Varπ    Help: NodeTypePtr;π    a,b : NodeTypePtr;ππ  beginπ    if (Root=NIL) thenπ      RETURN(NIL)π    ELSif (N>1) thenπ      a := MergeSort(Root,N div 2);π      b := MergeSort(Root,(N+1) div 2);π      RETURN(MergeLists(a,b))π    elseπ      Help := Root;π      Root := Root^.Next;π      Help^.Next := NIL;π      RETURN(Help)π    endπ  end MergeSort;ππbeginπ  if (List^.N<2) then RETURN end;π  if (Ascending) then Result := LISTGreater else Result := LISTLess end;π  List^.top^.Next := MergeSort(List^.top^.Next,List^.N);π  Last := List^.top;π  List^.Cursor := List^.top^.Next;π  While (List^.Cursor#NIL) doπ    List^.Cursor^.Prev := Last;π    Last := List^.Cursor;π    List^.Cursor := List^.Cursor^.Nextπ  end;π  Last^.Next := List^.Bottom;π  List^.Bottom^.Prev := Last;π  List^.CurPos := 1;π  List^.Cursor := List^.top^.Nextπend LISTSort;ππ{πThe basic data structure is defined as follows:π}ππConstπ  MaxClasses   = 256;ππTypeπ  NodeTypePtr = Pointer to NodeType;ππ  NodeType = Recordπ    Prev   : NodeTypePtr;π    Next   : NodeTypePtr;π    DataPtr: ADDRESSπ  end;ππ  LISTType = Pointer to ListType;ππ  ListType = Recordπ    top    : NodeTypePtr;π    Bottom : NodeTypePtr;π    Cursor : NodeTypePtr;π    N      : CARDinAL;π    CurPos : CARDinAL;π    ClassID: CARDinALπ  end;ππ  ClassType = Recordπ    Cmp  : LISTCompareProcType;π    Bytes: CARDinALπ  end;ππVarπ  Classes: Array [0..MaxClasses-1] of ClassType;π                                                                     28     05-28-9313:57ALL                      SWAG SUPPORT TEAM        SORT-PTR.PAS             IMPORT              11     S╙░ {π   This is using the concept of a PoINter Array (an Array of PoINters).  Itπallows For a _very_ large amount of data, sINce you allocate each Record spaceπof the Heap.  You must allocate each space For each Record as you create theπRecord:π}ππ  New (INFOSTUFF[3]);  { allocates space For 3rd Record }π  With INFOSTUFF[6]^ do  { works With 6th Record }π    beginπ      NAME := 'Patrick Edwards'; IDNUM := 60000; MOM := ''π    end;ππ   The sort could be:ππVar T : INFO;πProcedure L_HSorT (LEFT,RIGHT : Word);      { Lo-Hi QuickSort }πVar LOWER,UPPER,MIDDLE : Word;π    PIVOT              : INFO;πbeginπ  LOWER := LEFT; UPPER := RIGHT; MIDDLE := (LEFT+RIGHT) div 2;π  PIVOT := INFOSTUFF[MIDDLE]^;π  Repeatπ    While INFOSTUFF[LOWER]^.NAME < PIVOT.NAME do INc(LOWER);π    While PIVOT.NAME < INFOSTUFF[UPPER]^.NAME do Dec(UPPER);π    if LOWER <= UPPER thenπ      beginπ        T := INFOSTUFF[LOWER]^; INFOSTUFF[LOWER]^ := INFOSTUFF[UPPER]^;π        INFOSTUFF[UPPER]^ := T;π        INc (LOWER); Dec (UPPER);π      end;π  Until LOWER > UPPER;π  if LEFT < UPPER then L_HSorT (LEFT, UPPER);π  if LOWER < RIGHT then L_HSorT (LOWER, RIGHT);πend;                                                { L_HSorT }ππ{   called as:ππL_HSorT (1,10);π}π                                                 29     05-28-9313:57ALL                      SWAG SUPPORT TEAM        SORT-STR.PAS             IMPORT              7      Sσá {πIt gets better and better.  The Procedure below is incredibly fast in theπsorting of the Strings in the Arrays!  1.2 sec For 1485 Strings.π}ππProcedure Sort(item : PFilearr; Last : Integer);πVarπ  i, j : Integer;π  span : Integer;πbeginπ  item^[0] := newstr('                       ');π  span := Last shr 1;  {Span=Last/2}π  While span > 0 doπ  beginπ  For i := Span to Last - 1 doπ  beginπ    For j := (i - Span + 1) downto 1 doπ    if item^[j]^ <= item^[j + Span]^ thenπ      j:=1   {to make it quit the j-loop}π    elseπ    begin {swap Array(j) With Array(j+Span)}π      item^[0] := item^[j];π      item^[j] := item^[j + Span];π      item^[j + Span] := item^[0];π    end;π  end;π  Span := Span shr 1; {Span=Span/2}π  end;πend;π                                    30     05-28-9313:57ALL                      SWAG SUPPORT TEAM        SORTFAST.PAS             IMPORT              21     S} {π> I might share With you a sorting Procedure which I developed Forπ> 'those Arrays we were talking about:π> ...π> Exeperimentally I used it on 1485 Strings, which took about 3 secπ> on my 386DX40.  Could you advise on some method to do it evenπ> faster?ππI'll share With you a little sort routine which I use often in my Programsπwhenever I need a fast and efficient routine With very low overhead... It Usesπconsiderably less code than your example, and should outperForm it. (It wouldπbe even faster if it was all coded in Assembly!-- hint hint DJ) :-)π}ππProcedure Sort_It( totalItems : Word );ππ  Function Is_Less( TemPtr1, TemPtr2 : Pointer ) : Boolean;π  beginπ    Is_Less := ( YourStruct(TemPtr1^).Item < YourStruct(TemPtr2^).Item );π  end;ππVarπ  I,J : Word;π  Cur : Word;ππbeginπ  For I := 1 to Pred(totalItems) doπ  beginπ    Cur := I;ππ    For J := I + 1 to totalItems doπ      if Is_Less( Item[J], Item[Cur] ) thenπ        ExchangeLongInts( LongInt(Item[J]), LongInt(Item[Cur]) );π  end; { For }ππend; { Proc }ππ{πThere's a couple things I should explain: The "ExchangeLongInts" Procedure isπfrom the TurboPower Opro's OpInline Unit. All it does is exchange two LongIntπTypes without you having to use a temporary Variable. It's fast and convenient,πbut not the only possible solution here. (I'm Typecasting the Pointer into aπLongInt For a 4-Byte swap.)ππ"totalItems" is the total number of items in your Array to sort.ππ"Item" is the actual Array; Item : Array[1..xx] of Pointer_to_Record;ππ"YourStruct" used in the "Is_Less" Function is Typecasting the actual structureπor Record that "Item" is referring to. It's the only portion of the code whichπlooks at your actual data. to reverse the sort order, simply change the "<" toπ">". to change what is being sorted, just change the ".Item" to something elseπlike ".Name" or ".Zip" or whatever else might be contained in your structure.ππThis routine is simple, has a minimum amount of code, Uses very little stack,πworks only With Pointers and you are only sorting memory addresses; it neverπactually move any of your physical data. (if you did, then it would be slow.)ππIt'll sort several thousand items in only a couple seconds even on slowerπmachines, and is super on small volume runs. I would imagine that it wouldπ(90 min left), (H)elp, More? start loosing steam around 1,000 to 2,000 items, but For me, it's the bestπchoice when memory is at a premium and the Arrays are fairly small.π}ππ                                                                                                   31     05-28-9313:57ALL                      SWAG SUPPORT TEAM        TIMESORT.PAS             IMPORT              69     S╬ {I wrote a small Program to bench both sort routines we posted. It was anπinteresting test, however it did raise a couple questions For me, which I'llπget to in a moment. (The following Program can be used as a skeleton For tryingπother sort routines too.)ππNeedless to say, the routine you posted was dramatically faster than the one Iπposted, even though both routines are non-recursive simple sorts.ππThe maximum efficient load of the routine you posted appears to be about 3000πelements. After that, additonal elements add time exponentially. For example,πit will sort 3000 elements in 5.1 seconds, but 5000 elements takes almost 16πseconds. The sort I posted became un-benchable [bearable] at about 3000πelements when it took over a minute to Complete. I didn't test it beyond thisπpoint.ππHere are the results from my 386 33Mhz machine-- your algorithm.ππ     500 Elements - 0.1   Secondsπ    1000 Elements - 0.8   Secondsπ    1500 Elements - 1.4   Secondsπ    2000 Elements - 2.6   Secondsπ    3000 Elements - 5.1   Seconds  <- Peak efficiency reachedπ    5000 Elements - 15.8  SecondsππHere is the Program I used to benchmark with. I made it so that you couldπ"tweak" portions of the sort and re-run the Program.ππIncidentally, I also Compiled this Program under Stony Brook's Pascal Plus andπwas suprised to find that it ran substantially slower. All optimizations on.ππRange Checking ($R+) exactly Doubled the time it took to sort.ππChanging "Span+1" to Succ(Span) and "total-1" to Pred(total) made the routineπabout 3% faster. However the routine then neglected to sort that last twoπelements. Adding "Inc(total,2)" solved the problem but I'm not sure why. I didπnot expect this behavior. Perhaps someone could explain why?ππI added a temporary Pointer Variable to your routine in place of the "NewStr('π...  ')" code you used to simplify it.ππand one last thing... Using OPRO's OpInline Function calledπ"ExchangeLongInts()" to do the swapping instead of using a temporary Varπincreased speed another 2% (Evident at > 2000 elements.) However I did notπinclude this so that anyone interested could Compile and run this without extraπUnits.π}ππ{$A+,B-,D-,E-,F-,G-,I+,L+,N-,O-,P-,Q+,R-,S+,T-,V-,X-,Y+}π{$M 32768,0,655360}ππProgram Sort_Test;  { Sorting Benchmark Using P. Beeftink's Algorithm }ππTypeπ   SmallArrPtr = ^SmallArr;π   SmallArr    = Array[1..10] of Char;   { Skip String & Length Byte }ππ   TTimeString = String[20];πππVarπ   SortArray : Array[1..5000] of SmallArrPtr; { A LARGE Array }ππ   TickCount : LongInt Absolute $0040:$006C;π { TickCount : LongInt VOLATILE Absolute $0040:$006C; } { For Pascal+ }π   Tstart,π   Ttime     : LongInt;ππ{------------------------------------------------------------------------}πProcedure StartTiming;πbeginπ  TStart := TickCount;ππ  {start at the beginning of a tick!}π  Repeat Until TStart <> TickCount;ππ  TStart := TickCount;ππend;π{------------------------------------------------------------------------}πProcedure StopTiming;πbeginπ  TTime := TickCount - TStart;πend;π{------------------------------------------------------------------------}πFunction Elapsed : TTimeString;πVar Temp : TTimeString;π   Sec10 : LongInt;πbeginππ  Sec10 := TTime * 2470 div 4497;π  Str( Sec10 : 4, Temp );ππ  if Temp[1] = ' ' then Temp[1] := '0';ππ  Inc( Temp[0] );π  Temp[ Length(Temp) ] := Temp[ Pred( Length( Temp ) ) ];π  Temp[ Pred( length( Temp ) ) ] := '.';ππ  Elapsed := Temp;πend;π{------------------------------------------------------------------------}πProcedure MakeRandomStrings( NumtoMake : Word );πVar RNum,π    I,S  : Word;π    Temp : String;πbeginππ  Temp := '';π  Temp[0] := Chr( 10 );π  Randomize;ππ  For I := 1 to NumtoMake doπ  beginππ    For S := 1 to 10 do     { Create Random Strings 10 Chars in length }π    beginπ      RNum := Random(26);π      Temp[S] := Chr( RNum + 65 );π    end;ππ    Move( Temp[1], SortArray[I]^, 10 );ππ  end;ππend; { Proc }π{------------------------------------------------------------------------}πProcedure KDSort( total : Word );π  {-My simple sort routine as posted in Pascal Echo }π  { With 2 slight modifications                     }πVarπ   i,j,π   Current : Word;π   TempPtr : Pointer;πbeginππ  For I := 1 to total doπ  beginππ    Current := I;ππ    For J := Succ(I) to total doπ    beginπ      if SortArray[J]^ < SortArray[Current]^ thenπ      beginπ         TempPtr            := SortArray[j];π         SortArray[j]       := SortArray[Current];π         SortArray[Current] := TempPtr;π      end; {if}π    end; {For}ππ  end; {For}ππend;π{------------------------------------------------------------------------}πProcedure PBSort(total : Integer);π  {-Peter Beeftink's Sort as Posted in Pascal Echo }π  { Also With slight modifications                 }πVarπ   I,j     : Integer;π   Span    : Integer;π   TempPtr : Pointer;πbeginππ  Inc(total,2);   { Required to Compensate For PRED and SUCC ? }ππ  Span := total SHR $01;ππ  While Span > 0 doπ  beginππ    For I := Span to Pred(total) {total-1} doπ    beginππ      For j := (I - Succ(Span) {Span+1} ) Downto 1 doπ        if (SortArray[j]^ <= SortArray[j+Span]^) then j := 1 elseπ        beginπ          TempPtr           := SortArray[j];π          SortArray[j]      := SortArray[j+Span];π          SortArray[j+Span] := TempPtr;π        end;ππ    end; {For}ππ    Span := Span SHR $01; { This does help speed over Span div 2! }ππ  end; {WhIle}ππend;π{------------------------------------------------------------------------}πProcedure Do_Sorting( SortAmount : Word );πbeginππ  MakeRandomStrings(SortAmount);ππ  Write('Sorting... ');ππ  StartTiming;ππ  PBSort(SortAmount); { Change to KDSort() to bench second sort routine }ππ  StopTiming;ππ  WriteLn(SortAmount:5,' Elements - ',Elapsed,' Seconds');ππend;π{------------------------------------------------------------------------}πVar C : Word;ππbeginππ  if MaxAvail < 5000 * Sizeof(SmallArr) then Halt; { not enough memory! }ππ  For C := 1 to 5000 do   { pre-allocate up front }π    GetMem(SortArray[C],Sizeof(SmallArr));πππ  Do_Sorting( 500   );   { Add more Do_Sorting()'s For whatever count }π  Do_Sorting( 1000  );   { you wish to test with.                     }π  Do_Sorting( 1500  );π  Do_Sorting( 2000  );π  Do_Sorting( 3000  );π  Do_Sorting( 5000  );πππ  { Un-comment the following if you wish to see the sorted output }ππ  {π  For C := 1 to 5000 do   { Change 5000 to the amount you sorted }π    WriteLn( SortArray[C]^ );πππ  For C := 1 to 5000 doπ    FreeMem(SortArray[C],Sizeof(SmallArr));ππend.π{πI plugged in a QuickSort algorithm in the "skeleton" Program in my previousπmessage to test perFormance. Here are the results:ππ     500 Elements - 0.1 Secondsπ    1000 Elements - 0.2 Secondsπ    1500 Elements - 0.4 Secondsπ    2000 Elements - 0.6 Secondsπ    3000 Elements - 0.9 Secondsπ    5000 Elements - 1.8 SecondsππVery fast indeed. I modified the algorithm to sort only by Pointers, andπoptimized a couple spots. Again, a slight speed increase is noted using OPRO'sπExchangeLongInts() in leu of using temporary Variables in 1 spot. if you haveπOPRO, replace them and you reduce the number of instructions by 2 perπiteration.ππThis is a split-list recursive sort. Works by making a pass through the entireπArray first and moves all "small" data to the left, and all "Large" data to theπright. then it sorts each half seperately.ππTake the following code segment and "plug" it into the skeleton in my previousπmessage. then change the "PBSort(SortAmount)" to "QuickSort(SortAmount)" to runπthe tests.ππHere is the code segment:ππ{------------------------------------------------------------------------}πProcedure QuickSort( total : Integer );π  {------------------------------------------}π  Procedure recQuickSort( L, R : Integer );π  Var K,I,J   : Integer;π      T,π      Temp    : Pointer;ππ  beginππ    if L < R thenπ    beginπ      T := SortArray[L];π      I := Pred(L);π      J := L;π      K := Succ(R);ππ      While Succ(J) < K doπ       if SortArray[Succ(J)]^ < SmallArrPtr(T)^ thenπ       beginπ         Inc(I,1);π         Inc(J,1);π         SortArray[I] := SortArray[J];π         SortArray[j] := T;π       end {if}π       elseπ       if SortArray[Succ(J)]^ > SmallArrPtr(T)^ thenπ       beginπ         Dec(K,1);π         Temp := SortArray[K];π         SortArray[K] := SortArray[Succ(J)];π         SortArray[Succ(J)] := Temp;π       end {if}π       elseπ       Inc(J,1);ππ       recQuickSort(L,I);π       recQuickSort(K,R);ππ    end; { if L < R }ππ  end; { Proc recQuickSort }π  {------------------------------------------}ππbeginππ  recQuickSort(1,total);ππend;{QuickSort}π{------------------------------------------------------------------------}π                             32     05-31-9307:15ALL                      GUY MCLOUGHLIN           Various SORT Methods     IMPORT              45     S╥Æ constπ  MaxItem = 30000;ππtypeπ  Item = word;π  Ar1K = array[1..MaxItem] of Item;πππ  (***** Selection sort routine.                                      *)π  (*                                                                  *)π  procedure SelectionSort ({update} var Data : Ar1K;π                           {input }     ItemsToSort : word);π  varπ    Temp   : Item;π    Min,π    Index1,π    Index2 : word;π  beginπ    for Index1 := 1 to pred(ItemsToSort) doπ      beginπ        Min := Index1;π        for Index2 := succ(Index1) to ItemsToSort doπ          if Data[Index2] < Data[Min] thenπ            Min := Index2;π        Temp := Data[Min];π        Data[Min] := Data[Index1];π        Data[Index1] := Tempπ      endπ  end;        (* SelectionSort.                                       *)πππ  (***** Insertion sort routine.                                      *)π  (*                                                                  *)π  procedure InsertionSort ({update} var Data : Ar1K;π                           {input }     ItemsToSort : word);π  varπ    Temp   : Item;π    Index1,π    Index2 : word;π  beginπ    for Index1 := 2 to ItemsToSort doπ      beginπ        Temp := Data[Index1];π        Index2 := Index1;π        while (Data[pred(Index2)] > Temp) doπ          beginπ            Data[Index2] := Data[pred(Index2)];π            dec(Index2)π          end;π        Data[Index2] := Tempπ      endπ  end;        (* InsertionSort.                                       *)πππ  (***** Bubble sort routine.                                         *)π  (*                                                                  *)π  procedure BubbleSort ({update} var Data : Ar1K;π                        {input }     ItemsToSort : word);π  varπ    Temp   : Item;π    Index1,π    Index2 : word;π  beginπ    for Index1 := ItemsToSort downto 1 doπ      for Index2 := 2 to Index1 doπ        if (Data[pred(Index2)] > Data[Index2]) thenπ          beginπ            Temp := Data[pred(Index2)];π            Data[pred(Index2)] := Data[Index2];π            Data[Index2] := Tempπ          endπ  end;        (* BubbleSort.                                          *)ππ  (***** Shell sort routine.                                          *)π  (*                                                                  *)π  procedure ShellSort ({update} var Data : Ar1K;π                       {input }     ItemsToSort : word);π  varπ    Temp   : Item;π    Index1, Index2, Index3 : word;π  beginπ    Index3 := 1;π    repeatπ      Index3 := succ(3 * Index3)π    until (Index3 > ItemsToSort);π    repeatπ      Index3 := (Index3 div 3);π      for Index1 := succ(Index3) to ItemsToSort doπ        beginπ          Temp := Data[Index1];π          Index2 := Index1;π          while (Data[(Index2 - Index3)] > Temp) doπ            beginπ              Data[Index2] := Data[(Index2 - Index3)];π              Index2 := (Index2 - Index3);π              if (Index2 <= Index3) thenπ                breakπ            end;π          Data[Index2] := Tempπ        endπ    until (Index3 = 1)π  end;        (* ShellSort.                                           *)πππ  (***** QuickSort routine.                                           *)π  (*                                                                  *)π  procedure QuickSort({update} var Data : Ar1K;π                      {input }     Left,π                                   Right : word);π  varπ    Temp   : Item;π    Index1, Index2, Pivot  : word;π  beginπ    Index1 := Left;π    Index2 := Right;π    Pivot := Data[(Left + Right) div 2];π    repeatπ      while (Data[Index1] < Pivot) doπ        inc(Index1);π      while (Pivot < Data[Index2]) doπ        dec(Index2);π      if (Index1 <= Index2) thenπ        beginπ          Temp := Data[Index1];π          Data[Index1] := Data[Index2];π          Data[Index2] := Temp;π          inc(Index1);π          dec(Index2)π        endπ      until (Index1 > Index2);π      if (Left < Index2) thenπ        QuickSort(Data, Left, Index2);π      if (Index1 < Right) thenπ        QuickSort(Data, Index1, Right)π  end;        (* QuickSort.                                           *)ππ  (***** Radix Exchange sort routine.                                 *)π  (*                                                                  *)π  procedure RadixExchange ({update} var Data   : ar1K;π                           {input }     ItemsToSort,π                                        Left,π                                        Right  : word;π                                        BitNum : shortint);π  varπ    Temp   : Item;π    Index1, Index2 : word;π  beginπ    if (Right > Left) and ( BitNum >= 0) thenπ      beginπ        Index1 := Left;π        Index2 := Right;π        repeatπ          while (((Data[Index1] shr BitNum) AND 1) = 0)π          and (Index1 < Index2) doπ            inc(Index1);π          while (((Data[Index2] shr BitNum) AND 1) = 1)π          and (Index1 < Index2) doπ            dec(Index2);π          Temp := Data[Index1];π          Data[Index1] := Data[Index2];π          Data[Index2] := Tempπ        until (Index2 = Index1);π        if (((Data[Right] shr BitNum) AND 1) = 0) thenπ          inc(Index2);π        RadixExchange(Data, ItemsToSort, Left, pred(Index2),π                      pred(BitNum));π        RadixExchange(Data, ItemsToSort, Index2, Right, pred(BitNum))π      endπ  end;        (* RadixExchange.                                       *)πππ(*π                               - Guyπ---π ■ DeLuxe²/386 1.25 #5060 ■ππ*)                                                                                                                  33     08-27-9319:59ALL                      GREGORY P. SMITH         Alpha Sorting            IMPORT              30     S   {πGREGORY P. SMITHππ> Well, that's easier said than done !  So far I've accomplished aπ> selection sort which takes about 10-15 minutes For 1000 Records, and I'mπ> gonna be needin to sort about 5000 For the Programz intended applicationπ> !!! Also the place that I'm writing this For has an 8088 With 640K RAMπ> <chuckle> !!! Could you pleez tell me how to do a merge sort <is thatπ> easier than quicksortππHere is an example followed by an exlpanation.π}ππTypeπ  ListPtr = ^List;π  List = Recordπ    next : ListPtr; { next node }π    str  : String;  { data to sort }π  end;ππ{ Splits List l into two half lists, h1 & h2 }πProcedure SplitList(l : ListPtr; Var h1, h2 :  ListPtr);πVarπ  listone : Boolean;π  tmp : ListPtr;πbeginπ  h1 := nil;π  h2 := nil;π  listone := True;            { start With first list }π  While l <> nil doπ  beginπ    tmp := l^.next;           { save next node to split }π    if listone thenπ    begin                     { insert a node in the first list }π      l^.next := h1;π      h1 := l;                { keep h1 at head }π    endπ    elseπ    begin                     { insert a node in the second list }π      l^.next := h2;π      h2 := l;                { keep h2 at head }π    end;π    l := tmp;                 { move to next node }π    listone := not listone;   { alternate lists to insert into }π  end;πend; { SplitList }ππ{----------------- Merge Sort -------------------}ππ{ merges sorted l1 & l2 into one sorted list (alphabetically) }πFunction MergeAlphaLists(l1, l2 : ListPtr) : ListPtr;πVarπ  tmp : ListPtr;  { resulting list }πbeginπ  if (l1 = nil) thenπ    tmp := l2π  elseπ  if (l2 = nil) thenπ    tmp := l1π  elseπ  if l1^.str < l2^.str thenπ  begin { lesser node first }π    tmp := l1;π    l1 := l1^.next;π  endπ  elseπ  beginπ    tmp := l2;π    l2 := l2^.next;π  end;π  MergeAlphaLists := tmp;               { return head of merged sorted list }π  While (l1 <> nil) and (l2 <> nil) do  { traverse lists }π  if l1^.str < l2^.str thenπ  beginπ    tmp^.next := l1; { add the lesser node }π    tmp := l1;       { move ahead }π    l1 := l1^.next;  { next node }π  endπ  elseπ  beginπ    tmp^.next := l2; { add the lesser node }π    tmp := l2;       { ahead 1 }π    l2 := l2^.next;  { next node }π  end;π  if (l1 <> nil) thenπ    tmp^.next := l1   { append remaining nodes }π  elseπ    tmp^.next := l2;πend; { MergeAlphaLists }ππ{ Sorts list l alphabetically }πFunction MergeSortAlpha(l : ListPtr) : ListPtr;πVarπ  sl1,π  sl2 : ListPtr;πbeginπ  if l <> nil then                 { empty list? }π    if l^.next <> nil thenπ    begin   { single node list? }π      inc(progress);π      SplitList(l, sl1, sl2);      { split list into two halves }π      sl1 := MergeSortAlpha(sl1);  { sort the first half }π      sl2 := MergeSortAlpha(sl2);  { sort the second half }π      MergeSortAlpha := MergeAlphaLists(sl1, sl2)  { combine sorted lists }π    endπ    elseπ      MergeSortAlpha := l   { single node is already sorted }π  elseπ    MergeSortAlpha := nilπend;ππ{πWhat mergesort does is to split the list into two equal halves.  It thenπmergesorts each of these halves, and merges them back together.  The Real workπis done in the merging step.  When the lists are split down to the level ofπsingle node lists they are merged together again in the correct order.  As itπpops out of the recursion the larger lists are sorted so that merging willπstill keep them in order because each node is > than the previous one.  This isπprobably the most widely used sorting algorithm (don't quote me) because it isπsimple but delivers n*log(n) performance like any good algorithm would.π}π                                                                                                 34     08-27-9320:16ALL                      NIKLAUS WIRHT            Classic Quicksort        IMPORT              35     S   {π> Can you show me any version of thew quick sort that you may have? I'veπ> never seen it and never used it before. I always used an insertion sortπ> For anything that I was doing.ππHere is one (long) non-recursive version, quite fast.π}ππTypeπ  _Compare  = Function(Var A, B) : Boolean;{ QuickSort Calls This }ππ{ --------------------------------------------------------------- }π{ QuickSort Algorithm by C.A.R. Hoare.  Non-Recursive adaptation  }π{ from "ALGORITHMS + DATA STRUCTURES = ProgramS" by Niklaus Wirth }π{ Prentice-Hall, 1976. Generalized For unTyped arguments.   }π{ --------------------------------------------------------------- }ππProcedure QuickSort(V      : Pointer;   { To Array of Records }π                    Cnt    : Word;      { Record Count        }π                    Len    : Word;      { Record Length       }π                    ALessB : _Compare); { Compare Function    }ππTypeπ  SortRec = Recordπ    Lt, Rt : Integerπ  end;ππ  SortStak = Array [0..1] of SortRec;ππVarπ  StkT,π  StkM,π  Ki, Kj,π  M       : Word;π  Rt, Lt,π  I, J    : Integer;π  Ps      : ^SortStak;π  Pw, Px  : Pointer;ππ  Procedure Push(Left, Right : Integer);π  beginπ    Ps^[StkT].Lt := Left;π    Ps^[StkT].Rt := Right;π    Inc(StkT);π  end;ππ  Procedure Pop(Var Left, Right : Integer);π  beginπ    Dec(StkT);π    Left  := Ps^[StkT].Lt;π    Right := Ps^[StkT].Rt;π  end;ππbegin {QSort}π  if (Cnt > 1) and (V <> Nil) Thenπ  beginπ    StkT := Cnt - 1;    { Record Count - 1 }π    Lt   := 1;          { Safety Valve    }ππ    { We need a stack of Log2(n-1) entries plus 1 spare For safety }ππ    Repeatπ      StkT := StkT SHR 1;π      Inc(Lt);π    Until StkT = 0; { 1+Log2(n-1) }ππ    StkM := Lt * SizeOf(SortRec) + Len + Len; { Stack Size + 2 Records }ππ    GetMem(Ps, StkM);   { Allocate Memory    }ππ    if Ps = Nil Thenπ      RunError(215); { Catastrophic Error }ππ    Pw := @Ps^[Lt];   { Swap Area Pointer  }π    Px := Ptr(Seg(Pw^), Ofs(Pw^) + Len); { Hold Area Pointer  }ππ    Lt := 0;π    Rt := Cnt - 1;  { Initial Partition  }ππ    Push(Lt, Rt);   { Push Entire Table  }ππ    While StkT > 0 Doπ    begin  { QuickSort Main Loop }π      Pop(Lt, Rt);   { Get Next Partition  }π      Repeatπ        I := Lt; J := Rt;  { Set Work Pointers }ππ        { Save Record at Partition Mid-Point in Hold Area }π        M := (LongInt(Lt) + Rt) div 2;π        Move(Ptr(Seg(V^), Ofs(V^) + M * Len)^, Px^, Len);ππ        { Get Useful Offsets to speed loops }π        Ki := I * Len + Ofs(V^);π        Kj := J * Len + Ofs(V^);ππ        Repeatπ          { Find Left-Most Entry >= Mid-Point Entry }π          While ALessB(Ptr(Seg(V^), Ki)^, Px^) Doπ          beginπ            Inc(Ki, Len);π            Inc(I)π          end;ππ          { Find Right-Most Entry <= Mid-Point Entry }π          While ALessB(Px^, Ptr(Seg(V^), Kj)^) Doπ          beginπ            Dec(Kj, Len);π            Dec(J)π          end;ππ          { if I > J, the partition has been exhausted }π          if I <= J Thenπ          beginπ            if I < J Then  { we have two Records to exchange }π            beginπ              Move(Ptr(Seg(V^), Ki)^, Pw^, Len);π              Move(Ptr(Seg(V^), Kj)^, Ptr(Seg(V^), Ki)^, Len);π              Move(Pw^, Ptr(Seg(V^), Kj)^, Len);π            end;ππ            Inc(I);π            Dec(J);π            Inc(Ki, Len);π            Dec(Kj, Len);π          end; { if I <= J }π        Until I > J;  { Until All Swaps Done }ππ        { We now have two partitions.  At left are all Records }π        { < X, and at right are all Records > X.  The larger   }π        { partition is stacked and we re-partition the residue }π        { Until time to pop a deferred partition.              }ππ        if (J - Lt) < (Rt - I) Then { Right-Most Partition is Larger }π        beginπ          if I < Rt Thenπ            Push(I, Rt); { Stack Right Side }π          Rt := J;    { Resume With Left }π        endπ        else  {  Left-Most Partition is Larger }π        beginπ          if Lt < J Thenπ            Push(Lt, J); { Stack Left Side   }π          Lt := I;    { Resume With Right }π        end;ππ      Until Lt >= Rt;  { QuickSort is now Complete }π    end;π    FreeMem(Ps, StkM);   { Free Stack and Work Areas }π  end;πend; {QSort}π                                                                                                                                35     08-27-9321:48ALL                      ALEXANDER CHRISTOV       QSort Methods            IMPORT              82     S   {πALEXANDER CHRISTOVππ I don't know if code like this has been posted on this echo, but anyway hereπit goes. It implements three different versions of Qsort which so far if theπfastest sorting algorithm known. However, it is not adequate For sorting FileπRecords. I've tested the routines and have worked With them For quite a While,πbut don't trust me 8-) Murphy never sleeps 8-)π}ππUnit SORT;π{─────────────────────────────────────────────────────────────────────────}π{ Purpose  : Unit that implements a generic QSort(), similar to           }π{            the one in the standard C library.                           }π{ Author   : Alexander Christov                                           }π{ Notes    : Very instructive on the use of Pointers in TP.               }π{                                                                         }π{  Use freely.                                                            }π{                                                                         }π{─────────────────────────────────────────────────────────────────────────}πInterfaceππType CmpFunc=Function(El1,El2:Pointer):Boolean;ππProcedure QSort(Base:Pointer;Elements,Size:Word;GT:CmpFunc);ππ{ Base      - Pointer to the first elementπ  Elements  - Number of elementsπ  Size      - Size of an element in Bytes. Use SizeOf() if in doubtπ  GT        - A Function of Type CmpFunc that compares the elements pointedπ              to by the first and the second arguments and returns Trueπ              if the first is greater than the second. GT = Greater Thanπ              8-)π}ππ{ Some commonly used CmpFunc }ππFunction bGT(El1,El2:Pointer):Boolean;      { Compares ^Byte }πFunction wGT(El1,El2:Pointer):Boolean;      { Compares ^Word }πFunction lGT(El1,El2:Pointer):Boolean;      { Compares ^LongInt }πFunction rGT(El1,El2:Pointer):Boolean;      { Compares ^Real }ππImplementationπ{$F+}ππType Dummy=Array[0..0] of Byte;π     pDummy=^Dummy;πππ{ Recursive Implementation }ππProcedure _Sort(Base:Pointer;L,R,Size:Word;GT:CmpFunc);πVar I,J:Integer;πVar X:Pointer;π Procedure SwapElements(El1,El2:Word);π Var Tmp:Pointer;π beginπ  GetMem(Tmp,Size);π  Move(pDummy(Base)^[El1*Size],Tmp^,Size);π  Move(pDummy(Base)^[El2*Size],pDummy(Base)^[El1*Size],Size);π  Move(Tmp^,pDummy(Base)^[El2*Size],Size);π  FreeMem(Tmp,Size);π end;πbeginπ I:=L;π J:=R;π GetMem(X,Size);π Move(pDummy(Base)^[((L+R) div 2)*Size],X^,Size);π Repeatπ  While GT(X,@pDummy(Base)^[I*Size]) do INC(I);π  While GT(@pDummy(Base)^[J*Size],X) do DEC(J);π  if I<=J then beginπ   if I<>J then SwapElements(I,J);π   INC(I);π   DEC(J);π  end;π Until I>J;π FreeMem(X,Size);π if L<J then _Sort(Base,L,J,Size,GT);π if I<R then _Sort(Base,I,R,Size,GT);πend;ππProcedure QSort(Base:Pointer;Elements,Size:Word;GT:CmpFunc);πbeginπ _Sort(Base,0,Elements-1,Size,GT);πend;ππFunction bGT(El1,El2:Pointer):Boolean;πType pByte=^Byte;πbeginπ bGt:=(pByte(El1)^>pByte(El2)^);πend;ππFunction wGT(El1,El2:Pointer):Boolean;πType pWord=^Word;πbeginπ wGt:=(pWord(El1)^>pWord(El2)^);πend;ππFunction lGT(El1,El2:Pointer):Boolean;πType pLongInt=^LongInt;πbeginπ lGt:=(pLongInt(El1)^>pLongInt(El2)^);πend;ππFunction rGT(El1,El2:Pointer):Boolean;πType pReal=^Real;πbeginπ rGt:=(pReal(El1)^>pReal(El2)^);πend;ππend.ππππ{$A-,B-,D+,E-,F+,G+,I-,L+,N-,O+,P+,Q-,R-,S-,T-,V-,X+,Y+}π{ I don't know which settings are Really necessary For this Unit, but sinceπ  I always work With the above, I'm including them to make sure the Unitπ  compiles in your computer. The only critical ones (I Think) are R- and F+π}πUnit SORT;π{─────────────────────────────────────────────────────────────────────────}π{ Purpose:   Unit that implements a generic QSort, similar to the         }π{            one in the standard C library, but a lot more general        }π{            This new version allows ordering of almost anything,         }π{            even structures whose elements are not contiguous in memory  }π{            or have strange mutual dependancies that don't allow "happy  }π{            swapping". Obviously, this version is slower than the        }π{            previous one. if you won't be sorting Linked Lists or        }π{            Collections, use the previous one.                           }π{ Author   : Alexander Christov                                           }π{ Notes    : Very instructive on the use of Pointers in TP.               }π{            This version does not limit the number of elements to        }π{            65535 since the need not be contiguous.                      }π{                                                                         }π{    Use freely.                                                          }π{                                                                         }π{─────────────────────────────────────────────────────────────────────────}πInterfaceππType CmpFunc=Function(El1,El2:Pointer):Boolean;π     AddrFunc=Function(Base:Pointer;Size,N:LongInt):Pointer;π     SwapProc=Procedure(El1,El2:Pointer;Size:LongInt);ππProcedure QSort(Base:Pointer;      { Pointer to the first element.π                                     if the user Writes his own GT, Addr andπ                                     Swap, this isn't Really necessary.π                                   }π                Elements:LongInt;  { Total number of elements }π                Size:Word;         { Size of an element in Bytes }π                GT:CmpFunc;        { Comparing Function  }π                Addr:AddrFunc;     { Addressing Function }π                Swap:SwapProc);    { Swapping Function }ππ{π  GT        - A funcion of Type CmpFunc that compares the elements pointedπ              to by its first and second arguments, and returns True if theπ              first element is Greater Than the second one. This Unit definesπ              some commonly used CmpFuncs:π                    bGT - Compares Bytesπ                    wGT - Compares Wordsπ                    lGT - Compares LongIntsπ                    rGT - Compares Realsππ  Addr      - A Function that receives the index of an element and mustπ              return a Pointer to it.π              This Unit defines the Functionπ                   LinearAddrπ              which can be used whenever the elements are locatedπ              contiguously in memory.ππ  Swap      - A Procedure that swaps the elements pointed by its arguments.π                    DirectSwapπ              is defined in the Unit, which can be used whenever the elementsπ              are mutually independent or no external processes are neededπ              when swapping two elementsπ}ππ{ Commonly used CmpFuncs }ππFunction bGT(El1,El2:Pointer):Boolean;      { Compares ^Byte }πFunction wGT(El1,El2:Pointer):Boolean;      { Compares ^Word }πFunction lGT(El1,El2:Pointer):Boolean;      { Compares ^LongInt }πFunction rGT(El1,El2:Pointer):Boolean;      { Compares ^Real }ππFunction LinearAddr(Base:Pointer;Size,N:LongInt):Pointer;πProcedure DirectSwap(El1,El2:Pointer;Size:LongInt);ππImplementationπ{$F+}ππType Dummy=Array[0..0] of Byte;π     pDummy=^Dummy;πππVar X,Middle:Pointer;ππProcedureπ_Sort(Base:Pointer;L,R:LongInt;Size:Word;GT:CmpFunc;Addr:AddrFunc;Swap:SwapProcπ);πVar I,J:LongInt;πbeginπ I:=L;π J:=R;π Move(Addr(Base,Size,(L+R) div 2)^,Middle^,Size);π Repeatπ  While GT(Middle,Addr(Base,Size,I)) do INC(I);π  While GT(Addr(Base,Size,J),Middle) do DEC(J);π  if I<=J then beginπ   if I<>J then Swap(Addr(Base,Size,I),Addr(Base,Size,J),Size);π   INC(I);π   DEC(J);π  end;π Until I>J;π if L<J then _Sort(Base,L,J,Size,GT,Addr,Swap);π if I<R then _Sort(Base,I,R,Size,GT,Addr,Swap);πend;ππProcedure QSort;πbeginπ GetMem(X,Size);  { <- Made in Arturo Ramirez 8-) }π GetMem(Middle,Size);π _Sort(Base,0,Elements-1,Size,GT,Addr,Swap);π FreeMem(X,Size);π FreeMem(Middle,Size);πend;ππFunction bGT(El1,El2:Pointer):Boolean;πType pByte=^Byte;πbeginπ bGt:=(pByte(El1)^>pByte(El2)^);πend;ππFunction wGT(El1,El2:Pointer):Boolean;πType pWord=^Word;πbeginπ wGt:=(pWord(El1)^>pWord(El2)^);πend;ππFunction lGT(El1,El2:Pointer):Boolean;πType pLongInt=^LongInt;πbeginπ lGt:=(pLongInt(El1)^>pLongInt(El2)^);πend;ππFunction rGT(El1,El2:Pointer):Boolean;πType pReal=^Real;πbeginπ rGt:=(pReal(El1)^>pReal(El2)^);πend;ππ{ Linear Addressing }ππFunction LinearAddr;πbeginπ LinearAddr:=@pdummy(Base)^[N*Size];πend;ππ{ Direct swapping of elements. With the use of Addr() it is quite moreπ legible 8-) }ππProcedure DirectSwap;πVar Tmp:Pointer;πbeginπ GetMem(Tmp,Size);π Move(El1^,Tmp^,Size);π Move(El2^,El1^,Size);π Move(Tmp^,El2^,Size);π FreeMem(Tmp,Size);πend;ππend.πππ{ And finally a specific version of QSort() written in Assembler. It isπ non recursive and sorts Arrays of Words of up to 16383 elements (sinceπ it Uses the addresses of the elements rather than their indexes, and sinceπ SizeOf(Word)=2 -> 16384*2=32768 "=" -32768, and the routine Uses signedπ comparisons between adresses.π  On my 386/33 it sorts 10 times an Array of 10000 Words in 3.6 sec, Whileπ the first QSort() does the same in 46 sec.ππ  Must be called Withππ Qsort(Pointer to the first element, 0, elements-1)ππ  Use freely. if you include the source directly in your Program, creditπ  must be given.π}ππProcedure QSort(Base:Pointer;L,R:Word);Assembler;πVar TmpL,TmpR,TmpDI:Word;πAsmπ xor AX,AXπ PUSH AXπ PUSH AX     { 0 0 will act as a flag on the stack indicating that no more }π PUSH R      { (L,R) pairs need to be sorted }π PUSH Lπ@MainLoop:π LES DI,Baseπ MOV TmpDI,DIπ xor SI,SIπ MOV BX,DIπ POP AX    { AX<-L }π MOV TmpL,AXπ MOV SI,AXπ SHL AX,1π ADD DI,AXπ POP AX    { AX<-R }π MOV TmpR,AXπ and AX,AX     { R can be never 0 except if this is the (0,0) flag }π JZ @endπ ADD SI,AXπ SHL AX,1π ADD BX,AXπ and SI,$FFFEπ ADD SI,TmpDIππ { ES:DI -> Element[I] (L)π   ES:BX -> Element[J] (R)π   ES:SI -> Element[(L+R) div 2]π }ππ MOV AX,ES:[SI]π@Loop1:π MOV CX,ES:[DI]π CMP AX,CXπ JNA @Loop2π ADD DI,2π JMP @Loop1π@Loop2:π MOV CX,ES:[BX]π CMP CX,AXπ JNA @Checkπ SUB BX,2π JMP @Loop2π@Check:π CMP DI,BXπ JG @Cont1π MOV CX,ES:[DI]π MOV DX,ES:[BX]π MOV ES:[DI],DXπ MOV ES:[BX],CXπ ADD DI,2π SUB BX,2π CMP DI,BXπ JNG @Loop1ππ@Cont1:π SUB DI,TmpDIπ SAR DI,1       { DI - I }π SUB BX,TmpDIπ SAR BX,1       { BX - J }π CMP DI,TmpRπ JGE @Cont2π PUSH TmpR      { I<R }π PUSH DIπ@Cont2:π CMP TmpL,BXπ JGE @MainLoopπ PUSH BX        { L<J }π PUSH TmpLπ JMP @MainLoopππ@end:πend;ππ                      36     08-27-9321:58ALL                      MATT HARGETT             Shell Sorting            IMPORT              7      S   {πMATT HARGETTππ: want to use the normal ole' bubble sorts and the like (on the order of N),π: for the mere fact that it's just plain old slow!  Could anyone please postπ: some code, or pseudo-code of a sort that is on the order of NxLog N?  It woπ}ππProgram ShellSort;ππVarπ  A      : Array [1..1000] of Word;π  I, J, N,π  K, Tmp : Integer;ππBeginπ  N := 1000;π  For I := 1 to N Doπ  Beginπ    A[I] := Random(5000) + 1;π    Write(A[I] : 6);π  End;ππ  For K := 3 DownTo 1 Doπ    For I := 1 to N - 1 Doπ      For J := I + 1 to N Doπ        If A[J] < A[I]π          thenπ          Beginπ            Tmp  := A[J];π            A[J] := A[I];π            A[I] := Tmp;π          End;ππ  Writeln;ππ  For I := 1 To N Doπ    Write(A[I] : 6);πEnd.ππ                              37     11-21-9309:46ALL                      BOB SWART                QUICK SORTER             SWAG9311            20     S   {πFrom: BOB SWARTπSubj: Sorting...π---------------------------------------------------------------------------π Does anyone know of a VERY fast way to sort something?  I wouldπ really like  to view some source code on this if possible.  I need toπ sort over 1200  strings, and do it rather quickly.ππ Try this, it uses a TStringCollection...π}ππ{$IFDEF VER70}π{$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,P-,Q-,R-,S+,T-,V-,X-}π{$ELSE}π{$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,R-,S+,V-,X-}π{$ENDIF}π{$M 16384,0,655360}π{π  Sorteer 3.0π  Borland Pascal (Objects) 7.0.π  Copr. (c) 9-29-1993 DwarFools & Consultancy drs. Robert E. Swartπ                      P.O. box 799π                      5702 NP  Helmondπ                      The Netherlandsπ  Code size: 5824 Bytesπ  Data size: 1254 Bytesπ  .EXE size: 4971 Bytesπ  ----------------------------------------------------------------π  Authors: Bob Swart (2:281/256.12)π           Hans van der Veeke (2:282/517.2)π}πuses {$IFDEF WINDOWS}π     WinCrt,π     {$ENDIF}π     Objects;ππTypeπ  PStr = ^TStr;π  TStr = object(TObject)π           StrName: PString;π           constructor Init(_StrName: String);π         end {TStr};ππ  constructor TStr.Init(_StrName: String);π  beginπ    TObject.Init;π    StrName := NewStr(_StrName)π  end {Init};ππTypeπ  PStrColl = ^TStrColl;π  TStrColl = object(TStringCollection)π               function KeyOf(Item: Pointer): Pointer; virtual;π             end {TStrColl};ππ  function TStrColl.KeyOf(Item: Pointer): Pointer;π  beginπ    KeyOf := PStr(Item)^.StrNameπ  end {KeyOf};ππvar StrColl: PStrColl;π    Line: String;π    F: Text;πbeginπ  writeln('Sorteer - Sort strings (c) 1993 by Bob Swart & Hans van der Veeke.'#13#10);π  if ParamCount = 0 thenπ  beginπ    writeln('Usage: Sorteer [ASCII file to be sorted]');π    Halt(0)π  end;π  Assign(F,ParamStr(1));π  reset(F);π  if IOResult <> 0 thenπ  beginπ    writeln('Error - could not open file ',ParamStr(1));π    Halt(1)π  end;π  StrColl := New(PStrColl,Init(1000,500));π  StrColl^.Duplicates := True; { make False for NO duplicates }π  while not Eof(F) doπ  beginπ    readln(F,Line);π    if Length(Line) > 0 then StrColl^.Insert(New(PStr, Init(Line)))π  end;π  Close(F);π  while StrColl^.Count > 0 doπ  beginπ    writeln(PStr(StrColl^.At(0))^.StrName^); { print first element }π    StrColl^.AtFree(0); { delete and dispose first element StrColl }π  endπend.π                                                              38     11-02-9306:21ALL                      IAN LIN                  Linked list sort         SWAG9311            29     S   (*πIAN LINππ> Can someone show me an example of how to properly dispose of a linked list?ππI was just as bad when I started in February. :) Anyhow, use mark andπrelease. They're 2 new things I've discovered and love much more thanπdispose or freemem. Use MARK(ram) where VAR RAM:POINTER {an untypedπpointer}. This will save the state of the heap. NOW, when you are done,πdo this: release(ram) and it's back the way it was. No freemem, no dispose,πjust RELEASE! I REALLY love it. :) Need to allocate and deallocate someπtimes in between the beginning and the end? Use more untyped pointers (eg.πRAM2, RAM3, etc.) and you get the picture. Gotta love it. :) Look for aπmessage from me in here about linked list sorting. I wrote an entireπprogram that does this (to replace DOS's sort. Mine's faster and can useπmore than 64k RAM). Here it is. Some of it is maybe too hard for you butπthen you can ignore that part and just see how I used mark and release.π*)ππ{$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,R-,S-,V-,X-}π{$M 8192, 0, 655360}ππtypeπ  pstring = ^string;π  prec    = ^rec;ππ  rec     = recordπ    s : pstring;π    n : prec;π  end;ππVarπ  dash   : byte;π  err,π  max, c : word;π  list,π  list2,π  node,π  node2  : prec;π  ram,π  ram2,π  ram3   : pointer;π  tf     : text;π  f      : file;ππprocedure dodash;πbeginπ  case dash ofπ    1 : write('-');π    2 : write('\');π    3 : write('|');π    4 : write('/');π  end;π  write(#8, ' ', #8);π  dash := dash mod 4 + 1;πend;ππprocedure TheEnd;πbeginπ  writeln('Assassin Technologies, NetRunner.');π  halt(err);πend;ππprocedure showhelp;πbeginπ  writeln('Heavy duty sorter. Syntax: NSORT <INFILE> <OUTFILE>.');π  writeln('Exit codes: 0-normal; 1-not enough RAM; 2-can''t open infile;');π  writeln('3-outfile can''t be created');π  halt;πend;ππprocedure noram;πbeginπ  release(ram);π  assign(f, paramstr(1));π  writeln('Not enough RAM. ', memavail div 1024, 'k; file: ', filesize(f));π  err := 1;π  halt;πend;ππprocedure newnode(var pntr : prec);πbeginπ  if sizeof(prec) > maxavail thenπ  beginπ    close(tf);π    noram;π  end;π  new(pntr);π  dodash;π  pntr^.n := nil;πend;ππprocedure getln(var ln : pstring);πvarπ  line : string;π  size : word;πbeginπ  readln(tf, line);π  size := succ(length(line));π  if size > maxavail thenπ    noram;π  getmem(ln, size);π  move(line, ln^, succ(length(line)));π  dodash;πend;ππbeginπ  err := 0;π  exitproc := @TheEnd;π  if paramcount = 0 thenπ    showhelp;π  assign(tf, paramstr(1));π  reset(tf);ππ  if ioresult <> 0 thenπ  beginπ    writeln('Can''t open "', paramstr(1), '".');π    err := 2;π    halt;π  end;ππ  mark(ram);π  newnode(list);ππ  if not eof(tf) thenπ  beginπ    getln(list^.s);π    node := list;ππ    while not eof(tf) doπ    beginπ      newnode(node^.n);π      node := node^.n;π      getln(node^.s);π    end;ππ    close(tf);π    newnode(list2);π    list2^.n := list;π    list := list^.n;π    list2^.n^.n := nil;ππ    while list <> nil doπ    beginπ      dodash;π      node  := list;π      list  := list^.n;π      node2 := list2;ππ      while (node2^.n <> nil) and (node^.s^ > node2^.n^.s^) doπ        node2 := node2^.n;ππ      node^.n  := node2^.n;π      node2^.n := node;π      dodash;π    end;π    list := list2^.n;ππ    assign(tf, paramstr(2));π    rewrite(tf);π    if ioresult <> 0 thenπ    beginπ      writeln('Can''t create "', paramstr(2), '"');π      err := 3;π    end;ππ    node := list;π    while node <> nil doπ    beginπ      writeln(tf, node^.s^);π      node := node^.n;π      dodash;π    end;π    writeln;π    close(tf);π    release(ram);π  end;πend.π                               39     11-02-9306:22ALL                      IAN LIN                  Quick Sort using LINK    SWAG9311            21     S   {πIAN LINππMy pride and joy, this baby sorts FAST! This is For anyone who wants anπexample of code For sorting linked lists.π}ππ{$A+,B-,D+,E-,F-,G+,I-,L+,N-,O-,R-,S+,V-,X-}π{$M 4096,0,655360}ππProcedure Theend; {could you think of a better name???}πbeginπ  Writeln('Assassin Technologies, NetRunner.');π  {members: Ian Lin, Martin Young, William Parslow, Scott Rogers; just a newπ   Programming group, that's all.}π  halt; {duh, kinda obvious you need to end the Program. :) }πend;ππTypeπ  prec  = ^rec;π  dType = String[96]; {put what you want here, it's fast anyhow}π  rec   = Recordπ    d : dType;π    n : prec;       {"next" field"}π end;ππVarπ  max, c : Word;    {maximum # of elements; Counter}π  list,π  list2,π  node,π  node2  : prec;    {first and second lists, temporary Pointers to nodes in the lists}π  ram    : Pointer; {save heap state For use With mark/release}ππbeginπ  max := memavail div sizeof(dType); {this takes too long but is THE maximum}π  max := 675;          {I picked this at random--it sorts in 2 seconds or so}π  Exitproc := @Theend; {just to be fancy}π  randomize;π  mark(ram);π  new(list);           {create list}π  list^.d := Char(random(10) + 48); {put something in it}π  node := list;π  For c := 2 to max doπ  beginπ    new(node^.n);π    node := node^.n;π    node^.n := nil;π    node^.d := Char(random(10) + 48);π  end;ππ  new(list2);         {begin NEW sorted list}π  list2^.n := list;   {steal the first node of list For list2}π  list := list^.n;π  list2^.n^.n := nil;π  While list <> nil doπ  begin               {now steal 'em all and add them in order}π    node  := list;    {point node to first node in LIST}π    list  := list^.n; {advance LIST Pointer one node, first node is now seperate}π    node2 := list2;   {ready to use NODE2 to find the correct entry point}π    While (node2^.n <> nil) and (node^.d > node2^.n^.d) doπ      node2 := node2^.n; {advance NODE2 as needed Until it marks theπ                          right place For NODE to be inserted}π    node^.n  := node2^.n;{insert NODE into the new list, in the correct order}π    node2^.n := node;    {connect node to the previous nodes in new list, if any}π  end;π  list := list2^.n;      {point LIST back to the top of the list, now in order}ππ  node := list;          {the rest is just to display it}π  Write('List: ');π  While node <> nil doπ  begin                  {as usual (at least With me), NIL is the end}π    Write(node^.d);π    node := node^.n;π  end;π  Writeln;π  release(ram);          {give all heap RAM back}πend.π                             40     09-26-9310:15ALL                      ROLAND WODITSCH          Classic QSORT Routine    SWAG9311            30     S   (*πFrom: ROLAND WODITSCHπSubj: QUICK SORTπ*)ππUNIT QSort5;ππINTERFACEπTYPE OrdFunction = FUNCTION(VAR a,b):BOOLEAN;ππPROCEDURE Sortiere(VAR SortArray; Elementgroesse,LoIndex,HiIndex: word;π                   SortKleiner: OrdFunction; von,bis:word);ππ{       SortArray  field to sort                                          }π{       LoIndex    the lowest,                                            }π{       HiIndex    the highest fieldindex like in the fielddeklarartion   }π{       OrdAdr     the funktion from typ OrdFunction (s.o.)               }π{       von, bis   the sortarea                                           }ππ{     befor calling (not befor bind!) your have to define a               }π{     asymmetric  order funktion :                                        }π{     function IrgendEinName(VAR x,y : TypDerFeldElemente):boolean        }π{     example: (*$F+*) function kleiner(VAR x,y: integer):boolean;        }π{                        begin kleiner:=x<y end;  (*$F-*)                 }π{               not:  kleiner:=x<=y  (not asymmetric!)                    }π{     attention: x and y must be VAR-parameters !!!                       }ππππIMPLEMENTATIONππprocedure Sortiere(VAR SortArray; ElementGroesse,LoIndex,HiIndex: word;π                       SortKleiner:OrdFunction; von,bis:word);π  type ArrayPtr = ^Byte;π  var Mitte, i0, j0, m0 : ArrayPtr;ππ  procedure Swap(VAR x,y; size : word);π    beginπ     INLINE ($1E/$C4/$B6/X/$C5/$BE/Y/$8B/$8E/SIZE/$E3/$0C/$26/$8A/$04/π             $86/$05/$26/$88/$04/$46/$47/$E2/$F4/$1F)π    end;ππ  function Element(i : word) : ArrayPtr;π    beginπ      Element:=ptr(seg(SortArray),ofs(SortArray)+i*ElementGroesse)π    end;ππ  procedure inc(var index : word; var pointer : ArrayPtr);π    beginπ      index:=succ(index);π      pointer:=ptr(seg(pointer^),ofs(pointer^)+ElementGroesse)π    end;ππ  procedure dec(var index : word; var pointer : ArrayPtr);π    beginπ      index:=pred(index);π      pointer:=ptr(seg(pointer^),ofs(pointer^)-ElementGroesse)π    end;ππ  procedure E_Sort(von, bis : word);π    label EXIT;π    var i, j : word;π    beginπ      if bis<=von then goto EXIT;π      i:=von; i0:=Element(i);π      while i<bis do beginπ        m0:=i0; j:=i; j0:=i0; inc(j,j0);π        while j<=bis do beginπ          if SortKleiner(j0^,m0^) then m0:=j0;π          inc(j,j0)π        end; (* WHILE j *)π        if m0<>i0 then Swap(i0^,m0^,ElementGroesse);π        inc(i,i0)π      end; (* WHILE i *)π      EXIT:π    end; (* E_Sort *)ππ  procedure Sort(von, bis : word);  (* Rekursive Quicksort *)π    label EXIT;π    var i, j : word;π    beginπ      if bis-von<6 then begin E_Sort(von,bis); goto EXIT end;π      i:=von; j:=bis; m0:=Element((i+j) SHR 1);π      move(m0^,Mitte^,ElementGroesse); i0:=Element(i); j0:=Element(j);π      while i<=j do beginπ        while SortKleiner(i0^,Mitte^) do inc(i,i0);π        while SortKleiner(Mitte^,j0^) do dec(j,j0);π        if i<=j then beginπ          if i<>j then Swap(i0^,j0^,ElementGroesse);π          inc(i,i0); dec(j,j0)π        end (* if i<=j *)π      end; (* while i<=j *)π      if bis-i<j-von then beginπ                       if i<bis then Sort(i,bis);π                       if von<j then Sort(von,j)π                       endπ                     else beginπ                       if von<j then Sort(von,j);π                       if i<bis then Sort(i,bis)π                       end;π      EXIT:π    end; (* Sort *)ππ  beginπ    getmem(Mitte,ElementGroesse);π    Sort(von-LoIndex,bis-LoIndex);π    freemem(Mitte,ElementGroesse)π  end; (* Sort *)ππEND. (* IMPLEMENTATION OF UNIT QSORT *)ππ                                                                                                           41     11-26-9317:46ALL                      SWAG SUPPORT GROUP       Complete Sorting Unit    SWAG9311            53     S   UNIT Sort;ππ  { These sort routines are for arrays of Integers.  Count is the maximum }π  { number of items in the array.                                         }ππ{****************************************************************************}π                             INTERFACEπ{****************************************************************************}πFUNCTION  BinarySearch (VAR A; X : Integer; Count : Integer) : Integer;πPROCEDURE BubbleSort (VAR A; Count : Integer); {slow}πPROCEDURE CombSort (VAR A; Count : Integer);πPROCEDURE QuickSort (VAR A; Count : Integer);  {fast}πFUNCTION  SequentialSearch (VAR A; X : Integer; Count : Integer) : Integer;πPROCEDURE ShellSort (VAR A; Count : Integer);  {moderate}π{****************************************************************************}π                             IMPLEMENTATIONπ{****************************************************************************}πTYPEπ  SortArray = ARRAY[0..0] OF Integer;π{****************************************************************************}π{                                                                            }π{                   Local Procedures and Functions                           }π{                                                                            }π{****************************************************************************}πPROCEDURE Swap (VAR A, B : Integer);πVAR C : Integer;πBEGINπ   C := A;π   A := B;π   B := C;πEND;π{****************************************************************************}π{                                                                            }π{                   Global Procedures and Functions                          }π{                                                                            }π{****************************************************************************}πFUNCTION BinarySearch (VAR A; X : Integer; Count : Integer) : Integer;πVAR High, Low, Mid : Integer;πBEGINπ  Low := 1;π  High := Count;π      WHILE High >= Low DOπ         BEGINπ            Mid := Trunc(High + Low) DIV 2;π            IF X > SortArray(A)[mid]π               THEN Low := Mid + 1π               ELSE IF X < SortArray(A)[Mid]π                       THEN High := Mid - 1π                       ELSE High := -1;π         END;π      IF High = -1π         THEN BinarySearch := Midπ         ELSE BinarySearch := 0;π   END;π{****************************************************************************}πPROCEDURE BubbleSort (VAR A; Count : Integer);πVAR i, j : Integer;πBEGINπ   FOR i := 2 TO Count DOπ     FOR j := Count DOWNTO i DOπ       IF SortArray(A)[j-1] > SortArray(A)[j]π          THEN Swap(SortArray(A)[j],SortArray(A)[j-1]);πEND;π{****************************************************************************}πPROCEDURE CombSort (VAR A; Count : Integer);π  { The combsort is an optimised version of the bubble sort. It uses a     }π  { decreasing gap in order to compare values of more than one element     }π  { apart.  By decreasing the gap the array is gradually "combed" into     }π  { order ... like combing your hair. First you get rid of the large       }π  { tangles, then the smaller ones ...                                     }π  { There are a few particular things about the combsort.                  }π  { Firstly, the optimal shrink factor is 1.3 (worked out through a        }π  { process of exhaustion by the guys at BYTE magazine). Secondly, by      }π  { never having a gap of 9 or 10, but always using 11, the sort is        }π  { faster.                                                                }π  { This sort approximates an n log n sort - it's faster than any other    }π  { sort I've seen except the quicksort (and it beats that too sometimes). }π  { The combsort does not slow down under *any* circumstances. In fact, on }π  { partially sorted lists (including *reverse* sorted lists) it speeds up.}πCONST ShrinkFactor = 1.3;  { Optimal shrink factor ...       }πVARπ  Gap, i, Temp : Integer;π  Finished : Boolean;πBEGINπ  Gap := Trunc(ShrinkFactor);π  REPEATπ    Finished := TRUE;π    Gap := Trunc(Gap/ShrinkFactor);π    IF Gap < 1π       THEN { Gap must *never* be less than 1 } Gap := 1π       ELSE IF Gap IN [9,10]π               THEN { Optimises the sort ... } Gap := 11;π    FOR i := 1 TO (Count - Gap) DOπ      IF SortArray(A)[i] < SortArray(A)[i+gap]π         THEN BEGINπ                Swap(SortArray(A)[i],SortArray(A)[i + Gap]);π                Finished := FALSE;π              END;π  UNTIL (Gap = 1) AND Finished;πEND;π{****************************************************************************}πPROCEDURE QuickSort (VAR A; Count : Integer);π  {**************************************************************************}π  PROCEDURE PartialSort(LowerBoundary, UpperBoundary : Integer; VAR A);π  VAR ii, l1, r1, i, j, k : Integer;π  BEGINπ    k := (SortArray(A)[LowerBoundary] + SortArray(A)[UpperBoundary]) DIV 2;π    i := LowerBoundary;π    j := UpperBoundary;π    REPEATπ      WHILE SortArray(A)[i] < k DO Inc(i);π      WHILE k < SortArray(A)[j] DO Dec(j);π      IF i <= jπ         THEN BEGINπ                Swap(SortArray(A)[i],SortArray(A)[j]);π                Inc(i);π                Dec(j);π              END;π    UNTIL i > j;π    IF LowerBoundary < jπ       THEN PartialSort(LowerBoundary,j,A);π    IF i < UpperBoundaryπ       THEN PartialSort(UpperBoundary,i,A);π  END;π  {*************************************************************************}πBEGINπ  PartialSort(1,Count,A);πEND;π{****************************************************************************}πFUNCTION SequentialSearch (VAR A; X : Integer; Count : Integer) : Integer;πVAR i : Integer;πBEGINπ  FOR i := 1 TO Count DOπ    IF X = Sortarray(A)[i]π       THEN BEGINπ              SequentialSearch := i;π              Exit;π            END;π  SequentialSearch := 0;πEND;π{****************************************************************************}πPROCEDURE ShellSort (VAR A; Count : Integer);πVAR Gap, i, j, k : Integer;πBEGINπ  Gap := Count DIV 2;π  WHILE (gap > 0) DOπ    BEGINπ      FOR i := (Gap + 1) TO Count DOπ        BEGINπ          j := i - Gap;π          WHILE (j > 0) DOπ            BEGINπ              k := j + gap;π              IF (SortArray(A)[j] <= SortArray(A)[k])π                 THEN j := 0π                 ELSE Swap(SortArray(A)[j],SortArray(A)[k]);π              j := j - Gap;π            END;π        END;π      Gap := Gap DIV 2;π    END;πEND;π{*****************************************************************************}πEND.π                                                                                                            42     11-26-9317:00ALL                      SWAG SUPPORT TEAM        Full featured Sort Unit  SWAG9311            83     S   Unit SORTER;ππINTERFACEππTYPEπ  PtrArray     = ARRAY[1..1] OF Pointer;ππ  TCompareFunction = FUNCTION (VAR AnArray; Item1, Item2 : LongInt) : Integer;π    { A TCompareFunction must return:   }π    {   1  if the Item1 > Item2         }π    {   0  if the Item1 = Item2         }π    {  -1  if the Item1 < Item2         }ππ  TSwapProcedure  = PROCEDURE (VAR AnArray; Item1, Item2 : LongInt);πππPROCEDURE CombSort (VAR AnArray; Min, Max : LongInt;π                    Compare : TCompareFunction; Swap : TSwapProcedure);ππ  { Compare Procedures - Must write your own Compare for pointer variables. }π  { This allows one sort routine to be used on any array.                   }πFUNCTION  CompareChars    (VAR AnArray; Item1, Item2 : LongInt) : Integer;π                           FAR;πFUNCTION  CompareInts     (VAR AnArray; Item1, Item2 : LongInt) : Integer;π                           FAR;πFUNCTION  CompareLongInts (VAR AnArray; Item1, Item2 : LongInt) : Integer;π                           FAR;πFUNCTION  CompareReals    (VAR AnArray; Item1, Item2 : LongInt) : Integer;π                           FAR;πFUNCTION  CompareStrs     (VAR AnArray; Item1, Item2 : LongInt) : Integer;π                           FAR;ππ  { Swap procedures to be used in any sorting routine.  }π  { This allows one sorting routine to be on any array. }πPROCEDURE SwapChars    (VAR AnArray; A, B : LongInt); FAR;πPROCEDURE SwapInts     (VAR AnArray; A, B : LongInt); FAR;πPROCEDURE SwapLongInts (VAR AnArray; A, B : LongInt); FAR;πPROCEDURE SwapPtrs     (VAR AnArray; A, B : LongInt); FAR;πPROCEDURE SwapReals    (VAR AnArray; A, B : LongInt); FAR;πPROCEDURE SwapStrs     (VAR AnArray; A, B : LongInt); FAR;π{****************************************************************************}π                               IMPLEMENTATIONπ{****************************************************************************}πTYPEπ  CharArray    = ARRAY[1..1] OF Char;π  IntArray     = ARRAY[1..1] OF Integer;π  LongIntArray = ARRAY[1..1] OF LongInt;π  RealArray    = ARRAY[1..1] OF Real;π  StrArray     = ARRAY[1..1] OF String;ππ{****************************************************************************}π{                                                                            }π{                      Local Procedures and Functions                        }π{                                                                            }π{****************************************************************************}πPROCEDURE AdjustArrayIndexes (VAR Min, Max : LongInt);π  { Adjusts array indexes to a one-based array. }πVAR Fudge : LongInt;πBEGINπ  Fudge := 1 - Min;π  Inc(Min,Fudge);π  Inc(Max,Fudge);πEND;π{****************************************************************************}π{                                                                            }π{                      Global Procedures and Functions                       }π{                                                                            }π{****************************************************************************π}PROCEDURE CombSort (VAR AnArray; Min, Max : LongInt;π                    Compare : TCompareFunction; Swap : TSwapProcedure);π  { The combsort is an optimised version of the bubble sort. It uses a }π  { decreasing gap in order to compare values of more than one element }π  { apart.  By decreasing the gap the array is gradually "combed" into }π  { order ... like combing your hair. First you get rid of the large   }π  { tangles, then the smaller ones ...                                 }π  {                                                                    }π  { There are a few particular things about the combsort. Firstly, the }π  { optimal shrink factor is 1.3 (worked out through a process of      }π  { exhaustion by the guys at BYTE magazine). Secondly, by never       }π  { having a gap of 9 or 10, but always using 11, the sort is faster.  }π  {                                                                    }π  { This sort approximates an n log n sort - it's faster than any      }π  { other sort I've seen except the quicksort (and it beats that too   }π  { sometimes ... have you ever seen a quicksort become an (n-1)^2     }π  { sort ... ?). The combsort does not slow down under *any*           }π  { circumstances. In fact, on partially sorted lists (including       }π  { *reverse* sorted lists) it speeds up.                              }π  {                                                                    }π  { More information in the April 1991 BYTE magazine.                  }πCONST ShrinkFactor = 1.3;πVAR Gap, i   : LongInt;π    Finished : Boolean;πBEGINπ  AdjustArrayIndexes(Min,Max);π  Gap := Round(Max/ShrinkFactor);π  REPEATπ    Finished := TRUE;π    Gap := Trunc(Gap/ShrinkFactor);π    IF Gap < 1π       THEN Gap := 1π       ELSE IF (Gap = 9) OR (Gap = 10)π               THEN Gap := 11;π    FOR i := Min TO (Max - Gap) DOπ        IF Compare(AnArray,i,i+Gap) = 1π           THEN BEGINπ                  Swap(AnArray,i,i+Gap);π                  Finished := False;π                END;π  UNTIL ((Gap = 1) AND Finished);πEND;π{****************************************************************************π}{                                                                           π }{                            CompareπProcedures                              }{                                   π                                         }{**********************************π******************************************}FUNCTION CompareChars (VAR πAnArray; Item1, Item2 : LongInt) : Integer;BEGINπ  IF CharArray(AnArray)[Item1] < CharArray(AnArray)[Item2]π     THEN CompareChars := -1π     ELSE IF CharArray(AnArray)[Item1] = CharArray(AnArray)[Item2]π             THEN CompareChars := 0π             ELSE CompareChars := 1;πEND;π{*****************************************************************************}πFUNCTION CompareInts (VAR AnArray; Item1, Item2 : LongInt) : Integer;πBEGINπ  IF IntArray(AnArray)[Item1] < IntArray(AnArray)[Item2]π     THEN CompareInts := -1π     ELSE IF IntArray(AnArray)[Item1] = IntArray(AnArray)[Item2]π             THEN CompareInts := 0π             ELSE CompareInts := 1;πEND;π{*****************************************************************************}πFUNCTION CompareLongInts (VAR AnArray; Item1, Item2 : LongInt) : Integer;πBEGINπ  IF LongIntArray(AnArray)[Item1] < LongIntArray(AnArray)[Item2]π     THEN CompareLongInts := -1π     ELSE IF LongIntArray(AnArray)[Item1] = LongIntArray(AnArray)[Item2]π             THEN CompareLongInts := 0π             ELSE CompareLongInts := 1;πEND;π{*****************************************************************************}πFUNCTION CompareReals (VAR AnArray; Item1, Item2 : LongInt) : Integer;πBEGINπ  IF RealArray(AnArray)[Item1] < RealArray(AnArray)[Item2]π     THEN CompareReals := -1π     ELSE IF RealArray(AnArray)[Item1] = RealArray(AnArray)[Item2]π             THEN CompareReals := 0π             ELSE CompareReals := 1;πEND;π{*****************************************************************************}πFUNCTION CompareStrs (VAR AnArray; Item1, Item2 : LongInt) : Integer;πBEGINπ  IF StrArray(AnArray)[Item1] < StrArray(AnArray)[Item2]π     THEN CompareStrs := -1π     ELSE IF StrArray(AnArray)[Item1] = StrArray(AnArray)[Item2]π             THEN CompareStrs := 0π             ELSE CompareStrs := 1;πEND;π{****************************************************************************}π{                                                                            }π{                             Move Procedures                                }π{                                                                            }π{****************************************************************************}πPROCEDURE MoveChar (VAR AnArray; Item : LongInt; VAR Hold);πBEGINπ  Char(Hold) := CharArray(AnArray)[Item];πEND;π{****************************************************************************}π{                                                                            }π{                           MoveBack Procedures                              }π{                                                                            }π{****************************************************************************}πPROCEDURE MoveBackChar (VAR AnArray; Item : LongInt; VAR Hold);πBEGINπ  CharArray(AnArray)[Item] := Char(Hold);πEND;π{****************************************************************************}π{                                                                            }π{                             Swap Procedures                                }π{                                                                            }π{****************************************************************************}πPROCEDURE SwapChars (VAR AnArray; A, B : LongInt);πVAR Item : Char;πBEGINπ  Item := CharArray(AnArray)[A];π  CharArray(AnArray)[A] := CharArray(AnArray)[B];π  CharArray(AnArray)[B] := Item;πEND;π{*****************************************************************************}πPROCEDURE SwapInts (VAR AnArray; A, B : LongInt);πVAR Item : Integer;πBEGINπ  Item := IntArray(AnArray)[A];π  IntArray(AnArray)[A] := IntArray(AnArray)[B];π  IntArray(AnArray)[B] := Item;πEND;π{*****************************************************************************}πPROCEDURE SwapLongInts (VAR AnArray; A, B : LongInt);πVAR Item : LongInt;πBEGINπ  Item := LongIntArray(AnArray)[A];π  LongIntArray(AnArray)[A] := LongIntArray(AnArray)[B];π  LongIntArray(AnArray)[B] := Item;πEND;π{****************************************************************************}πPROCEDURE SwapPtrs (VAR AnArray; A, B : LongInt);πVAR Item : Pointer;πBEGINπ  Item := PtrArray(AnArray)[A];π  PtrArray(AnArray)[A] := PtrArray(AnArray)[B];π  PtrArray(AnArray)[B] := Item;πEND;π{****************************************************************************}πPROCEDURE SwapReals (VAR AnArray; A, B : LongInt);πVAR Item : Real;πBEGINπ  Item := RealArray(AnArray)[A];π  RealArray(AnArray)[A] := RealArray(AnArray)[B];π  RealArray(AnArray)[B] := Item;πEND;π{*****************************************************************************}πPROCEDURE SwapStrs (VAR AnArray; A, B : LongInt);πVAR Item : String;πBEGINπ  Item := StrArray(AnArray)[A];π  StrArray(AnArray)[A] := StrArray(AnArray)[B];π  StrArray(AnArray)[B] := Item;πEND;π{*****************************************************************************}πBEGINπEND.π